Cream of the Crop 20/Cream of the Crop 20 (Terry Blount) (1996).iso/program/abc9605.zip/ABC9605.CDE

Text File | 1996-04-29 | 1MB | 1 lines

Jeff S. Root                   ARABIC TO ROMAN NUMERALS       FidoNet QUIK_BAS Echo          02-22-96 (16:29)       QB, QBasic, PDS        78   2305     ROMANCE.BAS  ' ROMANCE.BAS * Arabic to Roman number translatorπ ' Copyright MCMXCV by Jeff S. Root, Minneapolis, MNπ ' FREEWARE * Unlimited use and distribution * QBASICπ π DEFINT A-Zπ π CLS : PRINTπ DOπ   Arabic$ = ""π   PRINT "Number: ";π   LOCATE , , 1, 12, 13   'Cursor onπ   DOπ     DO: k$ = INKEY$: LOOP WHILE LEN(k$) <> 1      'Get inputπ     IF k$ = CHR$(27) THEN Arabic$ = "": EXIT DO   'Escπ     IF k$ = CHR$(8) AND Arabic$ > "" THENπ       Arabic$ = LEFT$(Arabic$, LEN(Arabic$) - 1)  'Backspaceπ       PRINT CHR$(29); " "; CHR$(29);π     ELSEIF k$ > "/" AND k$ < ":" THEN             '0-9 are okπ       IF k$ = "0" AND Arabic$ = "" THEN k$ = ""   'No lead 0sπ       IF LEN(Arabic$) < 4 THENπ         Arabic$ = Arabic$ + k$: PRINT k$;      'Add characterπ       END IFπ     END IFπ   LOOP UNTIL k$ = CHR$(13)                     'Enterπ   LOCATE , 1, 0: PRINT TAB(13); : LOCATE , 1   'Cursor offπ   IF Arabic$ = "" THEN END                     'Exit ROMANCEπ π   a$ = "": b$ = "": c$ = "": d$ = ""π   n = LEN(Arabic$)π   SELECT CASE MID$(Arabic$, n, 1)π     CASE "1": a$ = "I"π     CASE "2": a$ = "II"π     CASE "3": a$ = "III"π     CASE "4": a$ = "IV"π     CASE "5": a$ = "V"π     CASE "6": a$ = "VI"π     CASE "7": a$ = "VII"π     CASE "8": a$ = "VIII"π     CASE "9": a$ = "IX"π   END SELECTπ   n = n - 1π   IF n THENπ     SELECT CASE MID$(Arabic$, n, 1)π       CASE "1": b$ = "X"π       CASE "2": b$ = "XX"π       CASE "3": b$ = "XXX"π       CASE "4": b$ = "XL"π       CASE "5": b$ = "L"π       CASE "6": b$ = "LX"π       CASE "7": b$ = "LXX"π       CASE "8": b$ = "LXXX"π       CASE "9": b$ = "XC"π     END SELECTπ     n = n - 1π     IF n THENπ       SELECT CASE MID$(Arabic$, n, 1)π         CASE "1": c$ = "C"π         CASE "2": c$ = "CC"π         CASE "3": c$ = "CCC"π         CASE "4": c$ = "CD"π         CASE "5": c$ = "D"π         CASE "6": c$ = "DC"π         CASE "7": c$ = "DCC"π         CASE "8": c$ = "DCCC"π         CASE "9": c$ = "CM"π       END SELECTπ       n = n - 1π       IF n THENπ         n = VAL(MID$(Arabic$, n, 1))π         FOR i = 1 TO n: d$ = d$ + "M": NEXT iπ       END IFπ     END IFπ   END IFπ   PRINT CHR$(30);π   PRINT SPC(4 - LEN(Arabic$)); Arabic$; " = ";π   PRINT d$; c$; b$; a$π   PRINTπ LOOPπDave Gjessing                  MATH TEST                      [e-mail]  03-30-96 (00:00)       QB, QBasic, PDS        459  15835    QMATHTST.BASDEFINT A-Zππ'QMATHTST.BAS - a little math test prog based on theπ'IFACE_06.BAS text user interface - Dave Gjessing 1996π'(as if *I* know anything about math! <BG>)ππ'Thanks to Ken Melvin for contributing the music bits to ABCπ'and to William Yu for maintaining same (ABC)ππmain:ππDLBox 2, 1, 23, 80, 176, 0, 15, 1, 0πMenuBar 1, 15, 1πDLBox 8, 26, 13, 54, 0, 1, 15, 1, 0πLOCATE 9, 30: PRINT "Addition"πLOCATE 10, 30: PRINT "Subtraction"πLOCATE 11, 30: PRINT "Multiplication"πLOCATE 12, 30: PRINT "Division"πIF TotalProbs! > 0 THENπ        Average! = (TotalCorrect! * 100) / TotalProbs!π        LOCATE 17, 18: PRINT " So far, your average score is  ";π        PRINT USING "###"; Average!;π        PRINT "% correct ";π        END IFπCommandPointer 9, 28, 12, 15, 1, DoLine%πSELECT CASE DoLine%π   CASE 9π   addprobsπ   GOTO mainπ   CASE 10π   subprobsπ   GOTO mainπ   CASE 11π   multprobsπ   GOTO mainπ   CASE 12π   divprobsπ   GOTO mainπ   CASE 610             'F10 key re-initializes score-keepingπ   TotalProbs! = 0π   TotalCorrect! = 0π   GOTO mainπ   CASE 900             'ESC key exits the programπ   CLSπ   LOCATE 11, 30: PRINT "Thanks for playing!"π   LOCATE 13, 25: PRINT "[e-mail]"π   SLEEP 3: CLSπ   ENDπ   CASE ELSE            'anything else does nothingπ   GOTO mainπEND SELECTππSUB addprobsπSHARED TotalProbs!πSHARED TotalCorrect!πDLBox 2, 1, 23, 80, 0, 1, 15, 1, 0πMenuBar 2, 15, 1ππLOCATE 3, 4: PRINT "Addition test!"πLOCATE 5, 4: PRINT "I, your computer, will be making up addition problems"πLOCATE 6, 4: PRINT "for you, based on the answers you give to the next few questions."πLOCATE 10, 4: INPUT "What is the largest number you want me to use"; topsπLOCATE 12, 4: INPUT "How many problems do you want me to give you (up to 20)"; probsπIF probs > 20 THEN probs = 20πTotalProbs! = TotalProbs! + probsπcorrect = 0πwrong = 0πDLBox 2, 1, 23, 80, 0, 1, 15, 1, 0πRANDOMIZE topsπ            FOR I% = 1 TO probsπ                LOCATE 1, 2: PRINT (probs - I%) + 1; " to go";π                x = INT(RND * tops) + 1π                y = INT(RND * tops) + 1π                answer = x + yπ                DLBox 12, 20, 14, 60, 0, 1, 15, 1, 0π                LOCATE 13, 23: PRINT y; " plus "; x; " equals ";π                INPUT tryπ                IF try = answer THEN correct = correct + 1: PLAY "t240o3l8d#fgl8b-p8l8gl2b-": LOCATE 8, 37: PRINT "RIGHT!": SLEEP 1: LOCATE 8, 37: PRINT "      "π                IF try <> answer THENπ                PLAY "t255l16o1bo4dg#o2f"π                wrong = wrong + 1π                LOCATE 15, 30: PRINT "the answer is "; answer;π                SLEEP 2π                DLBox 2, 1, 23, 80, 0, 1, 15, 1, 0π                END IFπ                LOCATE 1, 2: PRINT STRING$(40, 0);π            NEXT I%πDLBox 2, 1, 23, 80, 176, 1, 15, 1, 0πDLBox 8, 26, 11, 54, 0, 1, 15, 1, 0πLOCATE 9, 28: PRINT "you got -> "; correct; "correct"πTotalCorrect! = TotalCorrect! + correctπLOCATE 10, 28: PRINT "you got -> "; wrong; "wrong"πIF wrong = 0 THEN BEEPπDLBox 14, 26, 16, 54, 0, 1, 15, 1, 0πLOCATE 15, 28: LINE INPUT "press ENTER to continue "; junk$ππEND SUBππSUB CommandPointer (firstline%, Col%, BotLimit%, Fgc%, Bgc%, DoLine%)π'this is where the user reacts to menu choices...ππCOLOR Fgc%, Bgc%πDoLine% = firstline%    'set aside the first line (sent with the sub call)π                        'as the upper limit to the list. (Work with DoLine%)πLOCATE firstline%, Col% 'go to the line and column called for in theπ                        'subroutine callπPRINT CHR$(16)          'and print the line pointer on the screenππDO                      'run around in circles awaiting instructionsπselection$ = INKEY$πselection$ = UCASE$(selection$)ππ'the next two IF's move the pointer up and down...πIF selection$ = CHR$(0) + "H" THEN           'UpArrowπ   LOCATE DoLine%, Col%: PRINT CHR$(0)       'first blank out old pointerπ   DoLine% = DoLine% - 1                     'move up one lineπ   IF DoLine% < firstline% THEN DoLine% = BotLimit% 'jump to bottom if at topπ   LOCATE DoLine%, Col%                      'go to where directedπ   PRINT CHR$(16)                            'print new pointer on screenπ   END IFπIF selection$ = CHR$(0) + "P" THEN           'DnArrowπ   LOCATE DoLine%, Col%: PRINT CHR$(0)       'cover the last pointerπ   DoLine% = DoLine% + 1                     'move down one lineπ   IF DoLine% > BotLimit% THEN DoLine% = firstline% 'jump to top if at bottomπ   LOCATE DoLine%, Col%                      'go to where directedπ   PRINT CHR$(16)                            'new pointerπ   END IFππ'this IF reacts to the user pressing the ENTER key. The sub ends with a newπ'value for DoLine%, equal to the line that the pointer was on.πIF selection$ = CHR$(13) THENπ    DoLine% = DoLine%π    EXIT SUBπ    END IFππ'these other IF's return a value for DoLine% which is not a valid screenπ'coordinate. It is up to the SELECT CASE statements that follow the lineπ'that called CommandPointer to determine what to do with the returned valueππIF selection$ = CHR$(0) + CHR$(81) THEN      'page down keyπ   DoLine% = 100π   EXIT SUBπ   END IFπIF selection$ = CHR$(0) + CHR$(73) THEN      'page up keyπ   DoLine% = 200π   EXIT SUBπ   END IFπIF selection$ = CHR$(0) + CHR$(59) THEN      'F1 keyπ   DoLine% = 601π   EXIT SUBπ   END IFπIF selection$ = CHR$(0) + CHR$(60) THEN      'F2 keyπ   DoLine% = 602π   EXIT SUBπ   END IFπIF selection$ = CHR$(0) + CHR$(61) THEN      'F3 keyπ   DoLine% = 603π   EXIT SUBπ   END IFπIF selection$ = CHR$(0) + CHR$(62) THEN      'F4 keyπ   DoLine% = 604π   EXIT SUBπ   END IFπIF selection$ = CHR$(0) + CHR$(63) THEN      'F5 keyπ   DoLine% = 605π   EXIT SUBπ   END IFπIF selection$ = CHR$(0) + CHR$(64) THEN      'F6 keyπ   DoLine% = 606π   EXIT SUBπ   END IFπIF selection$ = CHR$(0) + CHR$(65) THEN      'F7 keyπ   DoLine% = 607π   EXIT SUBπ   END IFπIF selection$ = CHR$(0) + CHR$(66) THEN      'F8 keyπ   DoLine% = 608π   EXIT SUBπ   END IFπIF selection$ = CHR$(0) + CHR$(67) THEN      'F9 keyπ   DoLine% = 609π   EXIT SUBπ   END IFπIF selection$ = CHR$(0) + CHR$(68) THEN      'F10 keyπ   DoLine% = 610π   EXIT SUBπ   END IFπIF selection$ = CHR$(27) THEN                'escape keyπ   DoLine% = 900π   EXIT SUBπ   END IFπLOOPπ'break out of the loop and return to the calling module with a new variableπ'called DoLine%, equal to the line number on screen where the selected itemπ'was being displayed, or else with a number beyond the screen size (100, 200,π'etc.), which will be used to convey special instructionsπEND SUBππSUB divprobsπSHARED TotalProbs!πSHARED TotalCorrect!ππDLBox 2, 1, 23, 80, 0, 1, 15, 1, 0πMenuBar 2, 15, 1ππLOCATE 3, 4: PRINT "Division test!"πLOCATE 5, 4: PRINT "I, your computer, will be making up division problems"πLOCATE 6, 4: PRINT "for you, based on the answers you give to the next few questions."πLOCATE 8, 4: INPUT "What number do you want to divide by"; tableπLOCATE 10, 4: INPUT "What is the largest number you want me to use"; topsπLOCATE 12, 4: INPUT "How many problems do you want me to give you (up to 20)"; probsπIF probs > 20 THEN probs = 20πTotalProbs! = TotalProbs! + probsπcorrect = 0πwrong = 0πDLBox 2, 1, 23, 80, 0, 1, 15, 1, 0πRANDOMIZE topsπ            FOR I% = 1 TO probsπ                LOCATE 1, 2: PRINT (probs - I%) + 1; " to go";π                x = INT(RND * tops) + 1π                answer = x \ tableπ                DLBox 12, 20, 14, 60, 0, 1, 15, 1, 0π                LOCATE 13, 23: PRINT x; " divided by "; table; " equals ";π                LINE INPUT try$π                IF LEN(try$) = 0 THEN GOTO wrongπ                try = VAL(try$)π                IF try = answer THENπ                correct = correct + 1: PLAY "t240o3l8d#fgl8b-p8l8gl2b-": LOCATE 8, 37: PRINT "RIGHT!": SLEEP 1: LOCATE 8, 37: PRINT "      "π                GOTO nextprobπ                END IFπ                IF try <> answer THENπwrong:π                PLAY "t255l16o1bo4dg#o2f"π                wrong = wrong + 1π                LOCATE 15, 30: PRINT "the answer is "; answer;π                SLEEP 2π                DLBox 2, 1, 23, 80, 0, 1, 15, 1, 0π                END IFπnextprob:π                LOCATE 1, 2: PRINT STRING$(40, 0);π            NEXT I%πDLBox 2, 1, 23, 80, 176, 1, 15, 1, 0πDLBox 8, 26, 11, 54, 0, 1, 15, 1, 0πLOCATE 9, 28: PRINT "you got -> "; correct; "correct"πTotalCorrect! = TotalCorrect! + correctπLOCATE 10, 28: PRINT "you got -> "; wrong; "wrong"πIF wrong = 0 THEN BEEPπDLBox 14, 26, 16, 54, 0, 1, 15, 1, 0πLOCATE 15, 28: LINE INPUT "press ENTER to continue "; junk$ππEND SUBππSUB DLBox (TLine, LCol, BLine, RCol, FieldNo, border, Fgc, Bgc, shadow)π'DLBOX (DeLuxe Box) is a fancy box sub-routine that includesπ'a user-defined background character parameter, single or double-π'line border (or no border), and foreground and background color parameters,π'plus shadow or no shadow option.π'π'The no-border option makes this "box" routine able to replace "background"π'routines.πCOLOR Fgc, Bgcπ   IF border = 0 THEN    'no border at allπ      ULC = FieldNoπ      URC = FieldNoπ      LLC = FieldNoπ      LRC = FieldNoπ      HORIZ = FieldNoπ      VERT = FieldNoπ         END IFπ   IF border = 1 THEN   'single line borderπ      ULC = 218         'upper left cornerπ      URC = 191         'upper right cornerπ      LLC = 192         'lower left cornerπ      LRC = 217         'lower right cornerπ      HORIZ = 196       'horizontal linesπ      VERT = 179        'vertical linesπ         END IFπ   IF border = 2 THEN   'double line borderπ      ULC = 201         'ditto all aboveπ      URC = 187π      LLC = 200π      LRC = 188π      HORIZ = 205π      VERT = 186π         END IFππLOCATE TLine, LColπPRINT CHR$(ULC) + STRING$(((RCol - LCol) - 1), CHR$(HORIZ)) + CHR$(URC)πFOR x = 1 TO (BLine - TLine) - 1πLOCATE ((TLine + 1) + NextLine), LColπ   NextLine = NextLine + 1πPRINT CHR$(VERT) + STRING$(((RCol - LCol) - 1), CHR$(FieldNo)) + CHR$(VERT);πNEXT xπLOCATE BLine, LColπPRINT CHR$(LLC) + STRING$(((RCol - LCol) - 1), CHR$(HORIZ)) + CHR$(LRC);π ππIF shadow = 1 THEN   'for consistancy, use 1 for shadows, 0 for no shadowπ   IF BLine > 24 OR RCol > 79 THEN GOTO badshadowπCOLOR 7, 0           'shadows are darkππLOCATE BLine + 1, LCol + 1                 'across theπPRINT STRING$((RCol - LCol), CHR$(176));  'bottom...π πFOR I = TLine + 1 TO BLine + 1              'on theπLOCATE I, RCol + 1: PRINT CHR$(176);         'right sideπNEXTππEND IFπCOLOR Fgc, Bgc       'restore original colorsπbadshadow:ππEND SUBππSUB MenuBar (message, Fgc, Bgc)πCOLOR Bgc%, Bgc%                             'nothing but backgroundπLOCATE 1, 1: PRINT STRING$(80, 219);           'color bar 1 at topπLOCATE 24, 1: PRINT STRING$(80, 219);          'color bar 2 at bottomπLOCATE 25, 1: PRINT STRING$(80, 219);          'color bar 3 at very bottomπCOLOR Fgc%, Bgc%                             'activate foreground colorπprogname$ = "QMATHTST.BAS - a math test program in QBasic"πtitle1$ = "Select a subject"πLOCATE 25, (40 - (LEN(progname$) / 2)): PRINT progname$;   'prog nameππIF message% = 1 THENπ    LOCATE 1, 1: PRINT " <ESC> quits "; CHR$(4); " <ARROWS> & <ENTER> to select "; CHR$(4); " <F10> to re-set score"π    LOCATE 24, (40 - (LEN(title1$) / 2)): PRINT title1$;πEND IFππIF message% = 2 THENπEND IFππIF message% = 3 THENπEND IFππIF message% = 4 THENπEND IFππIF message% = 5 THENπEND IFππIF message% = 6 THENπEND IFππIF message% = 7 THENπEND IFππIF message% = 8 THENπEND IFππIF message% = 9 THENπEND IFππIF message% = 10 THENπEND IFππEND SUBππSUB multprobsπSHARED TotalProbs!πSHARED TotalCorrect!ππDLBox 2, 1, 23, 80, 0, 1, 15, 1, 0πMenuBar 2, 15, 1ππLOCATE 3, 4: PRINT "Multiplication test!"πLOCATE 5, 4: PRINT "I, your computer, will be making up multiplication problems"πLOCATE 6, 4: PRINT "for you, based on the answers you give to the next few questions."πLOCATE 8, 4: INPUT "What number do you want to multiply by"; tableπLOCATE 10, 4: INPUT "What is the largest number you want me to use"; topsπLOCATE 12, 4: INPUT "How many problems do you want me to give you (up to 20)"; probsπIF probs > 20 THEN probs = 20πTotalProbs! = TotalProbs! + probsππcorrect = 0πwrong = 0πDLBox 2, 1, 23, 80, 0, 1, 15, 1, 0πRANDOMIZE topsπ            FOR I% = 1 TO probsπ                LOCATE 1, 2: PRINT (probs - I%) + 1; " to go";π                x = INT(RND * tops) + 1π                answer = x * tableπ                DLBox 12, 20, 14, 60, 0, 1, 15, 1, 0π                LOCATE 13, 23: PRINT table; " times "; x; " equals ";π                INPUT tryπ                IF try = answer THEN correct = correct + 1: PLAY "t240o3l8d#fgl8b-p8l8gl2b-": LOCATE 8, 37: PRINT "RIGHT!": SLEEP 1: LOCATE 8, 37: PRINT "      "π                IF try <> answer THENπ                PLAY "t255l16o1bo4dg#o2f"π                wrong = wrong + 1π                LOCATE 15, 30: PRINT "the answer is "; answer;π                SLEEP 2π                DLBox 2, 1, 23, 80, 0, 1, 15, 1, 0π                END IFπ                LOCATE 1, 2: PRINT STRING$(40, 0);π            NEXT I%πDLBox 2, 1, 23, 80, 176, 1, 15, 1, 0πDLBox 8, 26, 11, 54, 0, 1, 15, 1, 0πLOCATE 9, 28: PRINT "you got -> "; correct; "correct"πTotalCorrect! = TotalCorrect! + correctπLOCATE 10, 28: PRINT "you got -> "; wrong; "wrong"πIF wrong = 0 THEN BEEPπDLBox 14, 26, 16, 54, 0, 1, 15, 1, 0πLOCATE 15, 28: LINE INPUT "press ENTER to continue "; junk$πEND SUBππSUB subprobsπSHARED TotalProbs!πSHARED TotalCorrect!ππDLBox 2, 1, 23, 80, 0, 1, 15, 1, 0πMenuBar 2, 15, 1ππLOCATE 3, 4: PRINT "Subtraction test!"πLOCATE 5, 4: PRINT "I, your computer, will be making up subtraction problems"πLOCATE 6, 4: PRINT "for you, based on the answers you give to the next few questions."πLOCATE 10, 4: INPUT "What is the largest number you want me to use"; topsπLOCATE 12, 4: INPUT "How many problems do you want me to give you (up to 20)"; probsπIF probs > 20 THEN probs = 20πTotalProbs! = TotalProbs! + probsππcorrect = 0πwrong = 0πDLBox 2, 1, 23, 80, 0, 1, 15, 1, 0πRANDOMIZE topsπ            FOR I% = 1 TO probsπ                LOCATE 1, 2: PRINT (probs - I%) + 1; " to go";π                x = INT(RND * tops) + 1π                y = INT(RND * tops) + 1π                DLBox 12, 20, 14, 60, 0, 1, 15, 1, 0π                IF x >= y THENπ                answer = x - yπ                LOCATE 13, 23: PRINT x; " take away "; y; " equals ";π                END IFπ                IF y > x THENπ                answer = y - xπ                LOCATE 13, 23: PRINT y; " take away "; x; " equals ";π                END IFπ                INPUT tryπ                IF try = answer THEN correct = correct + 1: PLAY "t240o3l8d#fgl8b-p8l8gl2b-": LOCATE 8, 37: PRINT "RIGHT!": SLEEP 1: LOCATE 8, 37: PRINT "      "π                IF try <> answer THENπ                PLAY "t255l16o1bo4dg#o2f"π                wrong = wrong + 1π                LOCATE 15, 30: PRINT "the answer is "; answer;π                SLEEP 2π                DLBox 2, 1, 23, 80, 0, 1, 15, 1, 0π                END IFπ                LOCATE 1, 2: PRINT STRING$(40, 0);π            NEXT I%πDLBox 2, 1, 23, 80, 176, 1, 15, 1, 0πDLBox 8, 26, 11, 54, 0, 1, 15, 1, 0πLOCATE 9, 28: PRINT "you got -> "; correct; "correct"πTotalCorrect! = TotalCorrect! + correctπLOCATE 10, 28: PRINT "you got -> "; wrong; "wrong"πIF wrong = 0 THEN BEEPπDLBox 14, 26, 16, 54, 0, 1, 15, 1, 0πLOCATE 15, 28: LINE INPUT "press ENTER to continue "; junk$ππEND SUBππDave Gjessing                  BUBBLE SORT                    [e-mail]  01-01-96 (00:00)       QB, QBasic, PDS        93   3331     BUBLSORT.BAS'SORTER3.BAS    Dave Gjessing, 12/31/95, cleaned and remarked 1/1/96π'I wanted to figure out how to sort a random file before the year was out!π'This routine seems to do the job pretty darn well.π'-worked this out with playing cards on the kitchen table. I guess this isπ'what is called a "bubble sort".ππDEFINT A-ZπTYPE fullnameπ   firstN AS STRING * 20π   lastN AS STRING * 20πEND TYPEπDIM SHARED entry AS fullnameπ'************************ start ******************************πmenu:πCLSπPRINT "1 - run the sorter"πPRINT "2 - add records"πPRINT "3 - review file"πPRINT "K - kill the file"πPRINT "(Q)uit"ππDO                      'get a keystrokeπans$ = INKEY$πIF ans$ = "1" THEN GOTO sortfileπIF ans$ = "2" THEN GOTO addrecsπIF ans$ = "3" THEN GOTO reviewπIF ans$ = "K" OR ans$ = "k" THEN KILL "sorter3.dat": GOTO menuπIF ans$ = "Q" OR ans$ = "q" THEN ENDπLOOPππ'******************> the sorting routine <*********************πsortfile:πOPEN "sorter3.dat" FOR RANDOM AS #1 LEN = LEN(entry)πnumrec = LOF(1) / LEN(entry)πDIM A AS fullname      'make a couple of distinct arrays to    πDIM B AS fullname      'hold TYPE fullname file entries in memoryππFOR x = 1 TO numrec               'do the whole thing for as manyπcounter = 1                       'records as there areππFOR y = 1 TO numrec - 1           '(-1 or blank record is added)π GET #1, counter, entry           'get the first (or next) recordπ  A = entry                       'put it in array Aπ   GET #1, counter + 1, entry     'get the second (or next + 1) recordπ    B = entry                     'put it in array Bπ    IF UCASE$(A.lastN) > UCASE$(B.lastN) THEN  'compare the arrays...ππ      'if the first is greater than the second, then switch theirπ      'places in the file, as follows.π       π        '(you may compare (and so sort by) *any* element of the array)π        '(the UCASE$ comparison is important; an uppercase letter hasπ        'a different ASCII value than it's lowercase counterpart!)ππ    entry = B                     'temporarily make entry = Bπ    PUT #1, counter, entry        'put that in A's former place (counter)π    entry = A                     'temporarily make entry = Aπ    PUT #1, counter + 1, entry    'put in B's former place (counter + 1)π    END IFπ   counter = counter + 1          'bump the counter(s)π  NEXT y                          'do this for all of themπNEXT x                            'do *entire* process for all of themπCLOSE 1                           'done!πGOTO menuππ'****************** get sample data ****************************πaddrecs:πLINE INPUT "first name : "; entry.firstNπLINE INPUT "last name  : "; entry.lastNπOPEN "sorter3.dat" FOR RANDOM AS #1 LEN = LEN(entry)πnumrec = LOF(1) / LEN(entry)πnumrec = numrec + 1πPUT #1, numrec, entryπCLOSE 1πGOTO menuππ'****************** look at the file ***************************πreview:πCLSπPRINT "here is the file": PRINTπOPEN "sorter3.dat" FOR RANDOM AS #1 LEN = LEN(entry)πnumrec = LOF(1) / LEN(entry)πcounter = 1πFOR x = counter TO numrecπGET #1, counter, entryπPRINT entry.lastN; " "; entry.firstNπcounter = counter + 1πNEXT xπPRINT : LINE INPUT "enter to continue"; junk$πCLOSE 1πGOTO menuπ'************************* end *******************************ππChristopher Pinder             EXPRESSION EVALUATOR           comp.lang.basic.misc           04-14-96 (10:55)       PB                     175  4500     EVALUATE.BAS' POWER BASIC SOURCEπ' A Recusive Descent Bracket Thingy to mess with parenthesized?π' Expressions. This is a bodged version in BASIC of the code givenπ' in Bjarne Stroustrup's The C++ Programming Language with theπ' Symbol Table Stuff stripped out.π' Very little error checking etc... but it works (Famous last words)π' Probably got more bugs than three year old yogurt but hey !ππ' I'm not too sure how copyright would go regarding a bit of codeπ' translated from a book into another language so I won't donate itπ' cos I might not have the right. But I wrote this version and I don'tπ' care wot happens to it.ππ%NUMBER   = 1π%END      = 3π%PLUS     = 4π%MINUS    = 5π%MUL      = 6π%DIV      = 7π%LP       = 8π%RP       = 9ππshared EVAL$πshared n$,vπshared currenttoken%ππFUNCTION  GetToken%π  shared n$,vπ  shared EVAL$π  shared currenttoken%π  static state%π  static curpos%π    if state% = 0 then curpos% = 1:n$="" 'yeuch !ππ        NUM$="0123456789."π        OPER$="+-*/=()~!@"π        WHITE$=" "+chr$(8)πππ'Skip whitespaceπ        x$=mid$(EVAL$,curpos%,1)π        l% = len(EVAL$)π        while (((instr(WHITE$,x$)) and (curpos%<l%) ))π          incr curpos%π          x$=mid$(EVAL$,curpos%,1)π        wendπ        if curpos% >= l% thenπ            currenttoken% = %END:π            state% = 0:π            exit functionπ        end ifππ        state% = 1:π        dp% = 0:π        zz$=""π        'do the numbers firstπ        if(instr(NUM$,x$)>0)thenπ          while   ((instr(NUM$,x$)>0)  and_π                  (instr(WHITE$,x$)=0) and_π                  (instr(OPER$,x$)=0)  and_π                  (dp% < 2))π        if x$="." then incr dp%:π            if dp% = 2 then exit function:π            zz$ =zz$+ x$π            if curpos% < l% thenπ              incr curpos%π                x$ = mid$(EVAL$,curpos%,1)π            end ifπ         wendπ         v = val(zz$)π         currenttoken% = %NUMBER:π         exit function:π         end ifππ         if instr(OPER$,x$) thenπ          incr curpos%π          select case x$:π              case "+":currenttoken% = %PLUSπ              case "-":currenttoken% = %MINUSπ              case "*":currenttoken% = %MULπ              case "/":currenttoken% = %DIVπ              case "(":currenttoken% = %LPπ              case ")":currenttoken% = %RPπ            case elseπ              currenttoken% = %END:π            end selectπ            exit functionπ         end ifπ end function:ππfunction exprπ     shared n$,v:π         shared currenttoken%π         local myleftπ         myleft = termπ         while 1π         select case currenttoken%π         case %PLUSπ          GetToken%π            myleft = myleft+term:iterateπ         case %MINUSπ          GetToken%π            myleft = myleft-term:iterateπ         case elseπ            expr = myleft: exit function:π         end selectπ         wendπend functionππfunction termπ    shared n$,v:π    local myleftπ        myleft = primπ        while 1π        select case currenttoken%π        case %MULπ          GetToken%π            myleft = myleft * prim: iterateπ        case %DIVπ          GetToken%π            d = prim : if d = 0.00 then d = 1π            myleft = myleft / d: iterateπ            case elseπ            term = myleft:exit function:π            end selectπ            wendπ    end functionπππfunction primπ    shared n$,v:π  select case currenttoken%π      case %NUMBERπ          prim = vπ            GetToken%π        case %LPπ          GetToken%π            e = exprπ            if(currenttoken% <> %RP) thenπ              prim = 0:π                print "Mismatched Parenthesis"π                exit functionπ                end ifπ            GetToken%π            prim = e:exit function:ππ        case %MINUSπ          GetToken%π            prim = - prim: exit functionππ        case %ENDπ        prim = 0:π        end selectπend function:πππFunction Evaluate(p$)π         shared EVAL$π         EVAL$=p$+" "    'cos we read ahead - tacky I know !π         GetToken%π         Evaluate = expr!π         end functionππ'----------------------------------------------------------------------π' And now - to eat the pudding !π'----------------------------------------------------------------------πππclsπprint "input or ! to end"πwhile a$ <> "!"π  a$ =""π  input a$π  ? a$ " = " ; evaluate(a$)πwendπLarry Stone                    EXTRACT/SET LOW & HIGH BYTES   QB TidBits                     06-07-91 (11:09)       QB, QBasic, PDS        90   3617     LSET.BAS    'Code to extract (or set) low and high bytes from an integer by Larry Stone,π'June 7, 1991.π'π'Code to extract (or set) low and high integers from a LONG derived from codeπ'published in the June, 1991, issue of "Inside QuickBASIC" by Doug Quebbeman.ππDEFINT A-Z                      'Default to integersππ'****************************************************************************π'                              TYPE Declarations                            *π'****************************************************************************ππTYPE Integr                     'Create a template (structure), Integrπ    Num AS INTEGER              '(only has 1 element)πEND TYPEππTYPE SplitInt                   'Create a template (structure), SplitIntπ    LowByte AS STRING * 1π    HiByte  AS STRING * 1πEND TYPEππTYPE Longe                      'Create a template (structure), Longeπ    Dword AS LONG               '(only has 1 element)πEND TYPEππTYPE SplitLong                  'Create a template (structure), SplitLongπ    LowWord AS INTEGERπ    HiWord AS INTEGERπEND TYPEππ'****************************************************************************π'                 DIM memory variables as Structured TYPEs                  *π'****************************************************************************ππDIM Integr AS Integr            'Create our memory variable, IntegrπDIM SplitInt AS SplitInt        'Create our memory variable, SplitIntπDIM Longe AS Longe              'Create our memory variable, LongeπDIM SplitLong AS SplitLong      'Create our memory variable, SplitLongππ'****************************************************************************π'                          Make It Work - Main Code                         *π'****************************************************************************ππCLS                             'Clear the screenππIntegr.Num = 32767πPRINT "Our INTEGER"; Integr.Num;ππLSET SplitInt = Integr          'Get low and high bytes of our IntegrπPRINT "has a low byte of"; ASC(SplitInt.LowByte);πPRINT "and a high byte of"; ASC(SplitInt.HiByte)ππSplitInt.HiByte = CHR$(128)     'Assign a new high byte for our IntegrπPRINT "Setting the high byte of the INTEGER to"; ASC(SplitInt.HiByte);ππLSET Integr = SplitInt          'Set the Integr to these new byte valuesπPRINT "changes it's value to "; Integr.NumπPRINTπππLonge.Dword = 131071πPRINT "Our LONG Integer"; Longe.Dword;ππLSET SplitLong = Longe          'Get the low and high integers of our LongeπPRINT "has a low integer of "; SplitLong.LowWord;πPRINT "and a high integer of"; SplitLong.HiWordππIntegr.Num = SplitLong.LowWord  'Assign Integr as the LowWordπLSET SplitInt = Integr          'Now get the bytes of our LowWordππPRINT "The low integer's ( "; Integr.Num; ") low byte is";πPRINT ASC(SplitInt.LowByte);πPRINT "and its high byte is"; ASC(SplitInt.HiByte)ππIntegr.Num = SplitLong.HiWord   'Assign Integr as the HiWordπLSET SplitInt = Integr          'Now get the low and high bytes of HiWordππPRINT "The high integer's ("; Integr.Num; ") low byte is";πPRINT ASC(SplitInt.LowByte);πPRINT "and its high byte is"; ASC(SplitInt.HiByte)πPRINTππSplitLong.HiWord = 32767        'Change the high INTEGER of our variableππPRINT "Assigning"; SplitLong.HiWord; "as our LONG's high word ";πLSET Longe = SplitLong          'Now assign the above integers to LongeππPRINT "changes its value to"; Longe.DwordπPRINT "The low integer of"; Longe.Dword; "reports as "; SplitLong.LowWord;πPRINT "and the high integer is"; SplitLong.HiWordπTony Elliott                   MONITOR SHELL & GET ERRORLEVEL QBTIPS_?.DOC                   12-23-92 (14:35)       ASM                    87   2521     MONSHELL.ASM; MonitorShell (MONSHELL.ASM)ππ; Written by Tony Elliottππ; EllTech Development, Inc.π; 4374 Shallowford Industrial Parkwayπ; Marietta, GA 30066π; [phone] Voice or [phone] BBS (DS)ππ; Released into the public domain.ππ; This routine is written for Microsoft QuickBASIC 4.x, BASIC 6.x and Microsoftπ; PDS 7.x. Assemble using MASM 5.1:  MASM MONSHELL;ππ; You can link it directly to your program, place it in a LINK library (.LIB)π; or a .QLB.ππ; To use it:ππ;   DECLARE SUB MonitorShell ()π;   DECLARE FUNCTION FetchErrorLevel% ()π;π;   CALL MonitorShellπ;   SHELL "PkZip -Xxy"π;   PRINT "ErrorLevel returned from SHELL:";FetchErrorLevel%ππ.model medium, basicπ.codeππOld21        Label Dword        ;Label pointing to old Int 21h handlerπOld21Offset  dw ?               ;Offset partπOld21Segment dw ?               ;Segment partπMonitorSet   db 0               ;Our "hooked" flagπExitCode     db ?               ;Where we store the exit codeππMonitorShell proc uses dsππ    ; From BASIC: CALL MonitorShellππ    cmp cs:MonitorSet,0         ;Are we already hooked?π    jnz MonitorExit             ;If so, exitπ    mov ax,3521h                ;Get current vector for int 21hπ    int 21hπ    mov cs:Old21Segment,es      ;Remember it for laterπ    mov cs:Old21Offset,bxπ    mov ax,2521hπ    push csπ    pop ds                      ;Point int 21h handler to our codeπ    mov dx, offset OurInt21π    int 21hπ    mov cs:MonitorSet,-1        ;Set our flagππMonitorExit:π    retππOurInt21:                       ;Our Int 21h handlerπ    cmp ah,4ch                  ;Is it a 'terminate' request?π    jnz Continue                ;If not, continue onππ    mov cs:ExitCode,al          ;Remember the exit codeπ    push axπ    push dsπ    mov ax,2521h                ;Unhook ourself after the first hitπ    mov ds,Old21Segmentπ    mov dx,Old21Offsetπ    int 21h                     ;Point Int 21h back to originalπhandlerπ    pop dsπ    pop axπ    mov cs:MonitorSet,0         ;Set out flag back to zeroπ    πContinue:π    jmp dword ptr [Old21]       ;Transfer control to original Int 21hππMonitorShell endpππFetchErrorLevel procππ    ;From BASIC: DECLARE FUNCTION FetchErrorLevel%π    ;            PRINT "Last errorlevel:"; FetchErrorLevel%ππ    mov al,cs:ExitCode          ;Put the errorlevel into alπ    xor ah,ah                   ;Zero ahπ    ret                         ;ErrorLevel returned as resultππFetchErrorLevel endpπ    endπBrent Ashley                   POSTIT! 5.0 FOR VB/DOS         QBTIPS_I.DOC                   03-02-93 (15:50)       VBDOS                  815  22307    VBPOSTIT.BAS'I've rewritten the recent PostIt v4.0 for VB/DOS as v5.0.π'You will notice I have cleaned up the code considerably,π'imposing a consistent style, insulating modules fromπ'each other, eliminating global variables, and added aπ'forms-based interface.π'π'I plan to finish a cleaned up QB version soon, too.π'π'Here is the make file for the project, called PI.MAK:π'π'POSTIT.FRMπ'PROGRESS.FRMππ'In the following messages are the two files listed above.ππ'Version 1.00πBEGIN Form frmPostitπ  BackColor    = QBColor(3)π  BorderStyle  = 1π  Caption      = "PostIt!"π  ControlBox   = 0π  Height       = Char(18)π  Left         = Char(9)π  MaxButton    = 0π  MinButton    = 0π  Top          = Char(2)π  Width        = Char(51)π  BEGIN CommandButton cmdGoπ    BackColor    = QBColor(3)π    Caption      = "&Do that PostIt magic!"π    Default      = -1π    Height       = Char(3)π    Left         = Char(0)π    TabIndex     = 16π    Top          = Char(13)π    Width        = Char(35)π  ENDπ  BEGIN CommandButton cmdExitπ    BackColor    = QBColor(3)π    Cancel       = -1π    Caption      = "E&xit"π    Height       = Char(3)π    Left         = Char(35)π    TabIndex     = 17π    Top          = Char(13)π    Width        = Char(14)π  ENDπ  BEGIN Frame fraOptπ    BackColor    = QBColor(3)π    Caption      = "Options"π    Height       = Char(10)π    Left         = Char(24)π    TabIndex     = 8π    Top          = Char(3)π    Width        = Char(25)π    BEGIN Frame fraFmtπ      BackColor    = QBColor(3)π      Caption      = "Format"π      Height       = Char(4)π      Left         = Char(1)π      TabIndex     = 13π      Top          = Char(4)π      Width        = Char(21)π      BEGIN OptionButton optFmtπ        BackColor    = QBColor(3)π        Caption      = "&Text MsgSplit"π        Height       = Char(1)π        Index        = 1π        Left         = Char(1)π        TabIndex     = 15π        TabStop      = 0π        Top          = Char(1)π        Value        = 0π        Width        = Char(18)π      ENDπ      BEGIN OptionButton optFmtπ        BackColor    = QBColor(3)π        Caption      = "&Binary PostIt"π        Height       = Char(1)π        Index        = 0π        Left         = Char(1)π        TabIndex     = 14π        Top          = Char(0)π        Value        = -1π        Width        = Char(18)π      ENDπ    ENDπ    BEGIN Label lblRsvdπ      BackColor    = QBColor(3)π      BorderStyle  = 0π      Caption      = "&Reserved Lns:"π      Height       = Char(1)π      Left         = Char(1)π      TabIndex     = 11π      Top          = Char(2)π      Width        = Char(14)π    ENDπ    BEGIN TextBox txtRsvdπ      BackColor    = QBColor(3)π      BorderStyle  = 1π      Height       = Char(1)π      Left         = Char(15)π      MultiLine    = 0π      TabIndex     = 12π      Text         = "3"π      Top          = Char(2)π      Width        = Char(7)π    ENDπ    BEGIN Label lblLenπ      BackColor    = QBColor(3)π      BorderStyle  = 0π      Caption      = "Page &Length:"π      Height       = Char(1)π      Left         = Char(1)π      TabIndex     = 9π      Top          = Char(0)π      Width        = Char(13)π    ENDπ    BEGIN TextBox txtLenπ      BackColor    = QBColor(3)π      BorderStyle  = 1π      Height       = Char(1)π      Left         = Char(15)π      MultiLine    = 0π      TabIndex     = 10π      Text         = "95"π      Top          = Char(0)π      Width        = Char(7)π    ENDπ  ENDπ  BEGIN CommandButton cmdSourceπ    BackColor    = QBColor(3)π    Caption      = "&Open..."π    Height       = Char(3)π    Left         = Char(40)π    TabIndex     = 2π    Top          = Char(0)π    Width        = Char(9)π  ENDπ  BEGIN Frame fraOutπ    BackColor    = QBColor(3)π    Caption      = "Output"π    Height       = Char(10)π    Left         = Char(0)π    TabIndex     = 3π    Top          = Char(3)π    Width        = Char(23)π    BEGIN Label lblExtπ      BackColor    = QBColor(3)π      BorderStyle  = 0π      Caption      = "&Extension:"π      Height       = Char(1)π      Left         = Char(1)π      TabIndex     = 6π      Top          = Char(5)π      Width        = Char(11)π    ENDπ    BEGIN Label lblPrefixπ      BackColor    = QBColor(3)π      BorderStyle  = 0π      Caption      = "&Prefix:"π      Height       = Char(1)π      Left         = Char(1)π      TabIndex     = 4π      Top          = Char(2)π      Width        = Char(8)π    ENDπ    BEGIN TextBox txtPrefixπ      BackColor    = QBColor(3)π      BorderStyle  = 1π      Height       = Char(3)π      Left         = Char(9)π      MultiLine    = 0π      TabIndex     = 5π      Text         = "POSTIT"π      Top          = Char(1)π      Width        = Char(11)π    ENDπ    BEGIN TextBox txtExtπ      BackColor    = QBColor(3)π      BorderStyle  = 1π      Height       = Char(3)π      Left         = Char(12)π      MultiLine    = 0π      TabIndex     = 7π      Text         = "PIT"π      Top          = Char(4)π      Width        = Char(8)π    ENDπ  ENDπ  BEGIN Frame fraSourceπ    BackColor    = QBColor(3)π    Caption      = "&Source File:"π    Height       = Char(3)π    Left         = Char(0)π    TabIndex     = 0π    Top          = Char(0)π    Width        = Char(40)π    BEGIN TextBox txtSourceπ      BackColor    = QBColor(3)π      BorderStyle  = 0π      Height       = Char(1)π      Left         = Char(0)π      MultiLine    = 0π      TabIndex     = 1π      Text         = ""π      Top          = Char(0)π      Width        = Char(38)π    ENDπ  ENDπENDπ'$FORM frmProgressπ'$INCLUDE: 'constant.bi'π' Requires: CMNDLG.LIB/QLBππ'π' PostIt! - version 5.0 for VB/DOSπ'π' this code is in the PUBLIC DOMAINπ'π'         *********************************************************π'         *      PostIt! THE Binary <-> BASIC Script Creator      *π'         *********************************************************π'                                   * * *π'π' Purpose:π'π'   To enable the posting of  compressed  listings  on a text only net.π'   This program takes a binary or BASIC input file and converts it toπ'   a series of small, postable files which other people can captureπ'   and run to get the original binary file.π'π' Credits:π'π'   PostIt! meaty bits by Rich Geldreichπ'π'   MsgSplit meaty bits by Scott Wunsch and Victor Yiuπ'π'   with mods by:π'                Jim Giordanoπ'                Mark H. Butlerπ'                Quinn Tyler Jacksonπ'π'   this VB/DOS version written by Brent Ashley March 1st, 1993π'π'   Changes include modularizing and clarifying, imposingπ'   a consistent coding style, commenting, and speeding upπ'   PostIt module with single buffer grabπ'ππSUB cmdExit_Click ()π  ' pretty straightforward...π  ENDπEND SUBππSUB cmdGo_Click ()π  ' dir$ will crap out if given an invalid filename (i.e. ":" )π  ON LOCAL ERROR RESUME NEXTπ  IF LEN(LTRIM$(txtSource.text)) = 0 THENπ    BEEPπ    MSGBOX "You must choose a source file", 0, "Oops!"π  ELSEIF LEN(DIR$(txtSource.text)) = 0 THENπ    BEEPπ    MSGBOX "The file `" + txtSource.text + "' doesn't exist", 0, "Oops!"π  ELSEπ    ' all ok - do itπ    LOAD frmProgressπ  END IFπEND SUBππSUB cmdSource_Click ()ππ  ' get filespec using common dialogπ  CALL FileOpen(FileName$, PathName$, "*.*", "Choose Source File", 0, 7, 0, Cancel)ππ  IF NOT Cancel THENπ    ' ensure trailing \π    IF RIGHT$(PathName$, 1) <> "\" THEN PathName$ = PathName$ + "\"π    ' check for file too bigπ    FileNum = FREEFILEπ    OPEN PathName$ + FileName$ FOR BINARY AS #FileNumπ    IF LOF(FileNum) > 24575& THENπ      m$ = "Sorry - that file is bigger than the 24k limit!"π      BEEPπ      MSGBOX m$, 0, "Oops!"π      EXIT SUBπ    END IFππ    ' analyse for binary or msgsplitπ    Buf$ = SPACE$(32)π    GET #FileNum, , Buf$π    IsBinary = FALSEπ    FOR I = 1 TO LEN(Buf$)π      SELECT CASE ASC(MID$(Buf$, I, 1))π        CASE 0 TO 8, 14 TO 31π          ' control codesπ          IsBinary = TRUEπ          EXIT FORπ        CASE 128 TO 178, 219 TO 255π          ' might be binary, might notπ          HiAscii = HiAscii + 1π        CASE ELSEπ          ' text ascii or linedrawπ          ' passes throughπ      END SELECTπ    NEXTπ    ' set option according to analysed typeπ    IF IsBinary OR (HiAscii > 8) THENπ      optFmt(0).Value = TRUEπ    ELSEπ      optFmt(1).Value = TRUEπ    END IFππ    ' assign filespec to text boxπ    txtSource.text = PathName$ + FileName$ππ    ' extract prefix (first up to 6 chars of filename)π    DotPos = INSTR(FileName$, ".")π    IF DotPos THENπ      txtPrefix.text = LEFT$(LEFT$(FileName$, DotPos - 1), 6)π    ELSEπ      txtPrefix.text = LEFT$(FileName$, 6)π    END IFππ    ' we've got a file - get ready to do itπ    cmdGo.SETFOCUSπ  END IFππEND SUBππSUB Form_Load ()π  ' get source filename from command lineπ  FileSpec$ = COMMAND$π  IF LEN(DIR$(FileSpec$)) THENπ    txtSource.text = FileSpec$ππ    ' extract base filename from input filenameπ    FileBase$ = ""π    FOR I = LEN(FileSpec$) TO 1 STEP -1π      ThisChar$ = MID$(FileSpec$, I, 1)π      SELECT CASE ThisChar$π        CASE "\", ":", " "π          EXIT FORπ        CASE ELSEπ          FileBase$ = ThisChar$ + FileBase$π      END SELECTπ    NEXTππ    ' extract prefix (first up to 6 chars of filename)π    DotPos = INSTR(FileBase$, ".")π    IF DotPos THENπ      txtPrefix.text = LEFT$(LEFT$(FileBase$, DotPos - 1), 6)π    ELSEπ      txtPrefix.text = LEFT$(FileBase$, 6)π    END IFππ  END IFππ  ' set up border and title coloursπ  SCREEN.ControlPanel(ACTIVE_BORDER_BACKCOLOR) = CYANπ  SCREEN.ControlPanel(TITLEBAR_BACKCOLOR) = BLUEπ  SCREEN.ControlPanel(TITLEBAR_FORECOLOR) = YELLOWππ  frmPostit.SHOWπ  IF LEN(FileSpec$) = 0 THENπ    nl$ = CHR$(13) + CHR$(10)π    m$ = "           PostIt v5.0 for VB/DOS"π    m$ = m$ + nl$ + "                    ***" + nl$π    m$ = m$ + nl$ + "  PostIt by Rich Geldreich"π    m$ = m$ + nl$ + "  MsgSplit by Scott Wunsch and Victor Yiu  "π    m$ = m$ + nl$ + "  with mods by:"π    m$ = m$ + nl$ + "                Jim Giordano"π    m$ = m$ + nl$ + "                Mark H. Butler"π    m$ = m$ + nl$ + "                Quinn Tyler Jackson"π    m$ = m$ + nl$π    m$ = m$ + nl$ + "  VB/DOS version by Brent Ashley"π    m$ = m$ + nl$π    m$ = m$ + nl$ + "  PostIt! is in the PUBLIC DOMAIN"π    MSGBOX m$, 0, "Credits"π  END IFπEND SUBππSUB txtExt_Change ()π  ' save cursor positionπ  Cursor = txtExt.SelStartπ  ' uppercase and limit to three charsπ  txtExt.text = LEFT$(UCASE$(txtExt.text), 3)π  ' restore cursor positionπ  txtExt.SelStart = CursorπEND SUBππSUB txtLen_KeyPress (KeyAscii AS INTEGER)π  ' limit to numbersπ  SELECT CASE KeyAsciiπ    CASE ASC("0") TO ASC("9"), KEY_SPACE, KEY_DELETE, KEY_BACKπ      'okiedokieπ    CASE ELSEπ      BEEPπ      ' ignore keyπ      KeyAscii = 0π  END SELECTπEND SUBππSUB txtLen_LostFocus ()π  ' ensure valid Len valueπ  txtLen.text = LTRIM$(STR$(VAL(txtLen.text)))π  IF VAL(txtLen.text) > 99 THEN txtLen.text = "99"π  IF VAL(txtLen.text) < 3 THEN txtLen.text = "3"πEND SUBππSUB txtPrefix_Change ()π  ' save cursor positionπ  Cursor = txtPrefix.SelStartπ  ' uppercase and limit to six charactersπ  txtPrefix.text = LEFT$(UCASE$(txtPrefix.text), 6)π  ' restore cursor positionπ  txtPrefix.SelStart = CursorπEND SUBππSUB txtRsvd_KeyPress (KeyAscii AS INTEGER)π  ' limit to numbersπ  SELECT CASE KeyAsciiπ    CASE ASC("0") TO ASC("9"), KEY_SPACE, KEY_DELETE, KEY_BACKπ      'okiedokieπ    CASE ELSEπ      BEEPπ      ' ignore keyπ      KeyAscii = 0π  END SELECTπEND SUBππSUB txtRsvd_LostFocus ()π  ' ensure valid Rsvd valueπ  txtRsvd.text = LTRIM$(STR$(VAL(txtRsvd.text)))π  IF VAL(txtRsvd.text) > 50 THEN txtRsvd.text = "50"π  IF VAL(txtRsvd.text) < 0 THEN txtRsvd.text = "0"πEND SUBππBEGIN Form frmProgressπ  BackColor    = QBColor(3)π  BorderStyle  = 3π  Caption      = "Progress"π  ControlBox   = 0π  Height       = Char(14)π  Left         = Char(32)π  MaxButton    = 0π  MinButton    = 0π  Top          = Char(9)π  Width        = Char(40)π  BEGIN Label lblBarπ    BackColor    = QBColor(3)π    BorderStyle  = 1π    Caption      = ""π    Height       = Char(3)π    Left         = Char(8)π    TabIndex     = 0π    Top          = Char(5)π    Width        = Char(27)π  ENDπ  BEGIN Label lblPctπ    BackColor    = QBColor(3)π    BorderStyle  = 0π    Caption      = "000%"π    Height       = Char(1)π    Left         = Char(2)π    TabIndex     = 1π    Top          = Char(6)π    Width        = Char(4)π  ENDπ  BEGIN Label lblWritπ    BackColor    = QBColor(3)π    BorderStyle  = 0π    Caption      = "Now Writing File:"π    Height       = Char(1)π    Left         = Char(1)π    TabIndex     = 2π    Top          = Char(2)π    Width        = Char(18)π  ENDπ  BEGIN Label lblCurFileπ    BackColor    = QBColor(3)π    BorderStyle  = 1π    Caption      = ""π    Height       = Char(3)π    Left         = Char(20)π    TabIndex     = 3π    Top          = Char(1)π    Width        = Char(16)π  ENDπ  BEGIN CommandButton cmdAbortπ    BackColor    = QBColor(3)π    Cancel       = -1π    Caption      = "&Abort"π    Height       = Char(3)π    Left         = Char(11)π    TabIndex     = 4π    Top          = Char(9)π    Width        = Char(18)π  ENDπENDπDECLARE FUNCTION ShowProgress% (Percent%, CurFile$)πDECLARE SUB MsgSplit (InFileName$, OutPrefix$, Ext$, LPP%, Reserve%, LineLength%)πDECLARE SUB PostIt (InFileName$, OutPrefix$, Ext$, LPP%, Reserve%, LineLength%)ππ'$FORM frmPostitπ'$INCLUDE: 'constant.bi'πDIM SHARED InProgress, AbortππSUB cmdAbort_Click ()π  SHARED InProgress, Abortππ  ' button performs two functions - Abort or Exitπ  IF InProgress THENπ    ' abortπ    Abort = TRUEπ  ELSEπ    ' exitπ    UNLOAD frmProgressπ  END IFπEND SUBππSUB Form_Load ()π  SHARED InProgress, Abortππ  ' turn off underlying form controlsπ  frmPostit.Enabled = FALSEππ  ' get call parameters from control valuesπ  InFileName$ = LTRIM$(RTRIM$(frmPostit.txtSource.text))π  OutPrefix$ = LTRIM$(RTRIM$(frmPostit.txtPrefix.text))π  Ext$ = LTRIM$(RTRIM$(frmPostit.txtExt.text))π  LPP = VAL(frmPostit.txtLen.text)π  Reserve = VAL(frmPostit.txtRsvd.text)π  LineLength = 72ππ  ' show current formπ  frmProgress.SHOWππ  ' do itπ  InProgress = TRUEπ  IF frmPostit.optFmt(0).Value THENπ    ' binary postitπ    frmProgress.Caption = "Binary Postit"π    PostIt InFileName$, OutPrefix$, Ext$, LPP, Reserve, LineLengthπ  ELSEπ    ' text msgsplitπ    frmProgress.Caption = "Text MsgSplit"π    MsgSplit InFileName$, OutPrefix$, Ext$, LPP, Reserve, LineLengthπ  END IFπ  BEEPπ  InProgress = FALSEππ  ' show result on exit buttonπ  IF Abort THENπ    cmdAbort.Caption = "Aborted - E&xit"π  ELSEπ    cmdAbort.Caption = "Done - E&xit"π  END IFπEND SUBππSUB Form_Unload (Cancel AS INTEGER)π  ' re-enable main form controlsπ  frmPostit.Enabled = TRUEπ  ' set focus to exit buttonπ  frmPostit.cmdExit.SETFOCUSπ  ' clear flag for further callsπ  Abort = FALSEπEND SUBππSUB MsgSplit (InFileName$, OutPrefix$, Ext$, LPP, Reserve, LineLength)ππ  ' initialize thingsπ  Ver$ = "v5.0"π  Tab$ = CHR$(9)π  Quote$ = CHR$(34)π  Snip1$ = "______O_/_________________| SNIP |________________\_O_____"π  Snip2$ = "      O \                 | HERE |                / O"π  LinesOut = Reserve + 1π  FileOutNum = 1π  LPP = LPP - 4   ' lines per pageππ  ' extract base filename from input filenameπ  InFileBase$ = ""π  FOR I = LEN(InFileName$) TO 1 STEP -1π    ThisChar$ = MID$(InFileName$, I, 1)π    SELECT CASE ThisChar$π      CASE "\", ":", " "π        EXIT FORπ      CASE ELSEπ        InFileBase$ = ThisChar$ + InFileBase$π    END SELECTπ  NEXTππ  ' open input file and get file lengthπ  InFile = FREEFILEπ  OPEN InFileName$ FOR INPUT AS #InFileπ  FileLen = LOF(InFile)ππ  DOπ    ' build outfile name - use leading zeros so filenames sort properlyπ    OutN$ = OutPrefix$ + RIGHT$(STR$(100 + FileOutNum), 2) + "." + Ext$ππ    OutFile = FREEFILEπ    OPEN OutN$ FOR OUTPUT AS #OutFileππ    IF FileOutNum > 1 THENπ      PRINT #OutFile, "'>>> Start of page"; STR$(FileOutNum); " of "; InFileBase$π      PRINT #OutFile,π    ELSEπ      PRINT #OutFile, Snip1$π      PRINT #OutFile, Snip2$π      PRINT #OutFile, "'This file created by PostIt! "; Ver$π      PRINT #OutFile, "'>>> Start of page"; STR$(FileOutNum); " of "; InFileBase$π      PRINT #OutFile,π    END IFπ        PRINT #OutFile,π      END IFππ      CLOSE #OutFileππ      IF NOT EOF(InFile) THENπ        ' update counterπ        FileOutNum = FileOutNum + 1π        LinesOut = 1π      END IFππ  LOOP UNTIL EOF(InFile)ππ  ' show 100% if not abortedπ  IF UserAbort = 0 THEN Dummy = ShowProgress(100, OutN$)π  CLOSE #InFile, #OutFileππEND SUBππSUB PostIt (InFileName$, OutPrefix$, Ext$, LPP, Reserve, LineLength)ππ  Ver$ = "v5.0"ππ  ' initialization stuffπ  DIM Shift(5)π  Shift(0) = 1π  Shift(1) = 2π  Shift(2) = 4π  Shift(3) = 8π  Shift(4) = 16π  Shift(5) = 32ππ  LinesOut = LinesOut + 2ππ  ValidChars$ = "abcdefghijklmnopqrstuvwxyz"π  ValidChars$ = ValidChars$ + "ABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789()"ππ  Qt$ = CHR$(34)π  Prefix$ = "G" + Qt$ππ  CurrentPage = 1π  Work$ = Prefix$π  CurrentBit = 0π  Char = 0ππ  ' extract base filename from input filenameπ  InFileBase$ = ""π  FOR I = LEN(InFileName$) TO 1 STEP -1π    ThisChar$ = MID$(InFileName$, I, 1)π    SELECT CASE ThisChar$π      CASE "\", ":", " "π        EXIT FORπ      CASE ELSEπ        InFileBase$ = ThisChar$ + InFileBase$π    END SELECTπ  NEXTππ  ' Open input fileπ  InFile = FREEFILEπ  OPEN InFileName$ FOR BINARY AS #InFileπ  FileLen = LOF(InFile)ππ  ' Open output file.π  F$ = OutPrefix$ + RIGHT$(STR$(100 + CurrentPage), 2) + "." + Ext$π  OutFile = FREEFILEπ  'use 8k output buffer for a little speedπ  OPEN F$ FOR OUTPUT AS #OutFile LEN = 8192ππ  ' initialise progress with filenameπ  Dummy = ShowProgress(0, F$)ππ  'Print the first 2 lines of the loader.π  PRINT #OutFile,"CLS:?STRING$(50,178):'This file created by PostIt! "; Ver$π  PRINT #OutFile, "DEFINT A-Z:FOR A=0 TO 6:P(A)=2^A:NEXT:OPEN "; Qt$; "B"; Qt$; ",1,"; Qt$; InFileBase$; Qt$π  PRINT #OutFile,"T$=";Qt$;"abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789()"; Qt$ππ  ' we've already determined the file is less than 24kπ  ' so we'll assume there's enough string space to hold itπ  Buf$ = SPACE$(FileLen)π  GET #InFile, , Buf$ππ  FOR CurrentByte = 1 TO FileLenπ    'shift the 8 bit character into the work bufferπ    Char = Char + ASC(MID$(Buf$, CurrentByte, 1)) * Shift(CurrentBit)ππ    'we've got 8 more bits nowπ    CurrentBit = CurrentBit + 8ππ    'write the 6 bit codes nowπ    DO WHILE CurrentBit > 5         'do we have at least 6 bits left?π      GOSUB PutByteπ      Char = Char \ 64              'shift it right 6 placesπ      CurrentBit = CurrentBit - 6  '6 bits less nowπ    LOOPπ  NEXTππ  'flush the input buffer if it contains any bitsπ  IF CurrentBit > 0 THEN GOSUB PutByteππ  'flush the line buffer if it contains any charactersπ  'Add a CHR$(34) to it just in case a mail reader decides to addπ  'some extra spaces to the end...ππ  IF LEN(Work$) > 2 THENπ    TheLine$ = Work$ + Qt$π    GOSUB PrintLineπ  END IFππ  ' main loader by Rich Geldreich with mods by Jim Giordianoπ  TheLine$ = "N=" + LTRIM$(STR$(FileLen)) + ":K=255:IF LEN(C$)<>"π  TheLine$ = TheLine$ + LTRIM$(STR$(BytesOut)) + " THEN ?" + Qt$π  TheLine$ = TheLine$ + "Incomplete script file!" + Qt$ + ":BEEP:END"π  GOSUB PrintLineππ  TheLine$ = "FOR A=1 TO N:LOCATE 1:?STRING$(50*(A/N),177):IF L=0"π  TheLine$ = TheLine$ + " THEN GOSUB G:L=6"π  GOSUB PrintLineππ  TheLine$ = "W=T\P(6-L):GOSUB G:W=W OR T*P(L):L=L-2:B$=CHR$(W AND"π  TheLine$ = TheLine$ + " K):PUT 1,,B$:NEXT"π  GOSUB PrintLineππ  TheLine$="?:IF C<>" + LTRIM$(STR$(CheckSum)) + " THEN ?" + Qt$ + "Bad"π  TheLine$ = TheLine$ + " checksum!" + Qt$ + ":BEEP:END ELSE ?" + Qt$π  TheLine$ = TheLine$ + "Success!" + Qt$ + ":END"π  GOSUB PrintLineππ  TheLine$ = "G:I=I+1:T=INSTR(T$,MID$(C$,I,1))-1:C=(C+T)*2:C=C\256+(C"π  TheLine$ = TheLine$ + " AND K):RETURN"π  GOSUB PrintLineππ  TheLine$ = "SUB G(A$):SHARED C$:C$=C$+LEFT$(A$," + LTRIM$(STR$(LineLength - 2))π  TheLine$ = TheLine$ + "):END SUB"π  GOSUB PrintLineππFinish:π  CLOSE #InFile, #OutFileππ  IF UserAbort = 0 THEN Dummy = ShowProgress(100, F$)ππ  EXIT SUBππPutByte:π  'write out the first 6 bitsπ  BytesOut = BytesOut + 1ππ  TheByte = Char AND 63π  'translate the output character into something safeπ  Work$ = Work$ + MID$(ValidChars$, TheByte + 1, 1)ππ  'calculate a checksum on the encoded data streamπ  CheckSum = (CheckSum + TheByte) * 2π  CheckSum = CheckSum \ 256 + (CheckSum AND 255)ππ  'if we have a complete line then write it outπ  IF LEN(Work$) = LineLength THENπ    TheLine$ = Work$π    GOSUB PrintLineπ    IF UserAbort THEN GOTO Finishπ    Work$ = Prefix$π  END IFπ  RETURNππPrintLine:π  UserAbort = ShowProgress(100& * CurrentByte \ FileLen, F$)π  ' don't just goto abort - we have to clean up gosub firstπ  IF UserAbort THEN RETURNππ  IF NewFileFlag THENπ    NewFileFlag = 0π    CurrentPage = CurrentPage + 1π    PRINT #OutFile, "'>>> Continued on Page "; CurrentPageπ    CLOSE #OutFileππ    F$ = OutPrefix$ + RIGHT$(STR$(100 + CurrentPage), 2) + "." + Ext$π    OPEN F$ FOR OUTPUT AS #OutFile LEN = 8192π    PRINT #OutFile, "'>>> Start of Page "; CurrentPage; " of "; InFileBase$π    LinesOut = 1π  END IFππ  PRINT #OutFile, TheLine$; " "π  LinesOut = LinesOut + 1π  IF LinesOut >= LPP THEN NewFileFlag = -1ππ  RETURNππEND SUBππFUNCTION ShowProgress (Percent, CurFile$)π  SHARED Abortππ  ' update status displayπ  lblCurFile.Caption = CurFile$π  lblPct.Caption = STR$(Percent) + "%"π  lblBar.Caption = STRING$(Percent \ 4, 177)ππ  ' return abort status (set TRUE in cmdAbort event)π  Dummy = DOEVENTS()π  ShowProgress = AbortπEND FUNCTIONπDouglas Lusher                 CLOCK SET                      FidoNet QUIK_BAS Echo          11-01-94 (00:00)       QB, QBasic, PDS        234  7102     CLOCKSET.BAS'Well, here we are at daylight saving time again. Thought Iπ'would repost this bit of code to set the time and date inπ'a computer by calling the NIST (National Institute ofπ'Standards and Technology) and obtaining the correct valuesπ'from their atomic clock. Just a note for those of you whoπ'may have gotten this code from when I have posted it inπ'the past: this is an updated version, there were a coupleπ'of subtle bugs in the previously posted versions.ππ DEFINT A-Zπ CONST False = 0, True = NOT Falseπ CONST Modem = 1ππ TimeOut$ = "*** Time limit exceeded, program aborted"π Abort$ = "*** Program aborted from keyboard"ππ PhoneNumber$ = "1-303-494-4774"π 'this is the phone number for the National Institute for Standardsπ 'and Technology in Colorado. It's the number I use for settingπ 'my computer's clock, so the rest of the program is written to useπ 'it. Listed below are some other numbers that you can call byπ 'modem for the same purpose, but I don't know anything about theπ 'service and info they provide.ππ 'PhoneNumber$ = "1-202-653-0351"π 'the United States Naval Observatory in Anapolis, Marylandππ 'PhoneNumber$ = "07-2217033"         ' Brisbane, Australiaπ 'PhoneNumber$ = "03-6001641"         ' Melbourne, Australiaππ ComSpec$ = "COM1:1200,N,8,1,BIN,CS0,DS0"π 'Change this ComSpec$ if your modem is on a different serial port.π '1200 baud and 300 baud are the only speeds available at NISTππ ON ERROR GOTO HandleErrorπ WIDTH 80π PRINTπ PRINT "CLOCKSET.BAS"π PRINT "A program to set the clock/calendar of an IBM compatible"π PRINT "computer after obtaining the correct date and time via modem."π PRINT "Written by Douglas H. Lusher, 11-01-1994"π PRINTπ PRINT "Time Zone? <E>astern, <C>entral, <M>ountain, <P>acific: ";π DOπ   LOCATE , , 1: Ky$ = INPUT$(1): LOCATE , , 0π   IF Ky$ = CHR$(27) THEN PRINT : PRINT Abort$: ENDπ   Ky$ = UCASE$(Ky$)π   TZ% = INSTR("ECMP", Ky$)π   IF TZ% THEN PRINT Ky$: TZ% = TZ% + 4: EXIT DOπ   BEEPπ LOOPπ 'If you require other time zones, the above code will haveπ 'to be altered. For Alaska, TZ% must be set equal to 9.π 'For Hawaii, set TZ% equal to 11.ππ PRINT "Daylight Savings Time? <Y>es, <N>o: ";π DOπ   LOCATE , , 1: Ky$ = INPUT$(1): LOCATE , , 0π   IF Ky$ = CHR$(27) THEN PRINT : PRINT Abort$: ENDπ   Ky$ = UCASE$(Ky$)π   IF Ky$ = "Y" OR Ky$ = "N" THEN PRINT Ky$: EXIT DOπ   BEEPπ LOOPπ IF Ky$ = "Y" THEN TZ% = TZ% - 1ππ Abort% = Falseπ OPEN ComSpec$ FOR RANDOM AS #Modemπ PRINT #Modem, "ATZ"π Start! = TIMERπ DOπ   IF LineReceived(ModemInput$) THENπ     IF INSTR(ModemInput$, "OK") THEN EXIT DOπ   ELSEIF INKEY$ = CHR$(27) THENπ     PRINT : PRINT Abort$: Abort% = True: EXIT DOπ   ELSEIF TimeSince!(Start!) > 20 THENπ     PRINT : PRINT TimeOut$: Abort% = True: EXIT DOπ   END IFπ LOOPππ IF Abort% THEN GOTO ProgramEndππ SLEEP (3)π PRINT #Modem, "ATDT"; PhoneNumber$π Start! = TIMERπ DOπ   IF LineReceived(ModemInput$) THENπ     IF INSTR(ModemInput$, "CONNECT") THENπ       EXIT DOπ     ELSEIF INSTR(ModemInput$, "BUSY") THENπ       Abort% = True: EXIT DOπ     ELSEIF INSTR(ModemInput$, "NO CARRIER") THENπ       Abort% = True: EXIT DOπ     ELSEIF INSTR(ModemInput$, "ERROR") THENπ       Abort% = True: EXIT DOπ     END IFπ   ELSEIF INKEY$ = CHR$(27) THENπ     PRINT : PRINT Abort$: Abort% = True: EXIT DOπ   ELSEIF TimeSince!(Start!) > 30 THENπ     PRINT : PRINT TimeOut$: Abort% = True: EXIT DOπ   END IFπ LOOPππ IF Abort% THEN GOTO ProgramEndππ Start! = TIMERπ LineCount% = 0π DOπ   IF LineReceived(ModemInput$) THENπ     'discard the first few lines to allow the connectionπ     '  to stabilizeπ     LineCount% = LineCount% + 1π     IF LineCount% > 10 THENπ       GOSUB SetClockπ       IF ClockSet% THEN EXIT DOπ     ELSEIF INSTR(ModemInput$, "NO CARRIER") THENπ       EXIT DOπ     ELSEIF INSTR(ModemInput$, "ERROR") THENπ       EXIT DOπ     END IFπ   ELSEIF INKEY$ = CHR$(27) THENπ     PRINT : PRINT Abort$: EXIT DOπ   ELSEIF TimeSince!(Start!) > 30 THENπ     PRINT : PRINT TimeOut$: EXIT DOπ   END IFπ LOOPππ ProgramEnd:π PRINT #Modem, "+++";π Start! = TIMERπ DO UNTIL TimeSince!(Start!) > 2: LOOPπ PRINT #Modem, "ATH0"π Start! = TIMERπ DOπ   IF LineReceived(ModemInput$) THENπ     IF INSTR(ModemInput$, "OK") THEN EXIT DOπ   ELSEIF TimeSince!(Start!) > 20 THENπ     EXIT DOπ   END IFπ LOOPπ CLOSE #Modemπ ENDππ SetClock:π 'lines containing the date and time info areπ '50 characters long and end with a "*" or "#"π IF LEN(ModemInput$) <> 50 THENπ   ClockSet% = False: RETURNπ END IFπ IF MID$(ModemInput$, 50) <> "*" AND MID$(ModemInput$, 50) <> "#" THENπ   ClockSet% = False: RETURNπ END IFπ 'get the date info from the lineπ D$ = MID$(ModemInput$, 10, 5) + "-19" + MID$(ModemInput$, 7, 2)π IF VAL(MID$(ModemInput$, 7, 2)) < 94 THEN MID$(D$, 7, 2) = "20"π 'get the time infoπ T$ = MID$(ModemInput$, 16, 8)π 'alter the time for the desired time zoneπ Hour% = VAL(T$) - TZ%π IF Hour% < 0 THENπ   'some adjustments will be necessaryπ   Hour% = Hour% + 24π   Day% = VAL(MID$(D$, 4, 2)) - 1π   IF Day% = 0 THENπ     Month% = VAL(MID$(D$, 1, 2)) - 1π     SELECT CASE Month%π       CASE 0π         Day% = 31π         Month% = 12π         Year% = VAL(MID$(D$, 7, 4)) - 1π         MID$(D$, 7, 4) = RIGHT$(STR$(Year%), 4)π       CASE 1, 3, 5, 7, 8, 10π         Day% = 31π       CASE 4, 6, 9, 11π         Day% = 30π       CASE 2π         Day% = 28π         Year% = VAL(MID$(D$, 7, 4))π         IF LeapYear(Year%) THEN Day% = 29π     END SELECTπ     MID$(D$, 1, 2) = RIGHT$(STR$(Month% + 100), 2)π   END IFπ   MID$(D$, 4, 2) = RIGHT$(STR$(Day% + 100), 2)π END IFπ MID$(T$, 1, 2) = RIGHT$(STR$(Hour% + 100), 2)π PRINT STRING$(58, "*")π PRINT "  Current settings: Date: "; DATE$, "Time: "; TIME$π DATE$ = D$: TIME$ = T$π PRINT "      Corrected to: Date: "; DATE$, "Time: "; TIME$π PRINT STRING$(58, "*"): PRINTπ ClockSet% = Trueπ RETURNππ HandleError:π ErrCode% = ERRπ IF ErrCode% = 57 THENπ   Err57% = Err57% + 1π   IF Err57% <= 5 THENπ     RESUMEπ   ELSEπ     PRINT "Program terminated; too many I/O errors."π     RESUME ProgramEndπ   END IFπ ELSEπ   PRINT "ERROR:"; ErrCode%; "- Program terminated."π   RESUME ProgramEndπ END IFππ FUNCTION LeapYear% (Year%) STATICπ 'returns True (-1) if the specified year is a leap yearπ   LY% = (Year% MOD 4 = 0) AND (Year% MOD 100 <> 0)π   LY% = LY% OR (Year% MOD 400 = 0)π   LeapYear% = LY%π END FUNCTIONππ FUNCTION LineReceived (Received$) STATICπ   CRLF$ = CHR$(13) + CHR$(10)π   LineReceived = Falseπ   IF LOC(Modem) THENπ     NewChars$ = INPUT$(LOC(Modem), #Modem)π     PRINT NewChars$;π     Buffer$ = Buffer$ + NewChars$π     LineEnd% = INSTR(Buffer$, CRLF$)π     IF LineEnd% THENπ       Received$ = LEFT$(Buffer$, LineEnd% - 1)π       Buffer$ = MID$(Buffer$, LineEnd% + 2)π       LineReceived = Trueπ     END IFπ   END IFπ END FUNCTIONππ FUNCTION TimeSince! (Mark!)π   TimeNow! = TIMERπ   TimeSince! = (TimeNow! - ((TimeNow! < Mark!) * 86400)) - Mark!π END FUNCTIONπSteve M. Wiegand               CALCULATE DAY OF WEEK          [e-mail]           04-21-96 (16:23)       QB, QBasic, PDS        729  28534    DAYOWEEK.BAS'This program will calculate a day of the week for any year from 1753 to 2030ππDEFINT A-ZπDECLARE SUB TRANSLATE ()πDECLARE SUB LETTERS ()πDECLARE SUB LAYER1 ()πDECLARE SUB NORMAL1 ()πDECLARE SUB NORMAL0 ()πDECLARE SUB Initialize ()πDECLARE SUB FancyCls (dots%, Background%)πDECLARE SUB Center (Row%, text$)πDECLARE SUB OPENINTRO ()πDECLARE SUB Box (Row1%, Col1%, Row2%, Col2%)πDECLARE SUB PAUSE ()πDECLARE SUB DAYERROR ()πDECLARE SUB inputerror ()πDECLARE FUNCTION GetNum# (Row%, Col%)πCONST TRUE = -1πCONST FLASE = NOT TRUEπCONST BYEAR = 1753πCOMMON SHARED P$(), P$, SIZE$πCOMMON SHARED C1$, C2$, C3$πCOMMON SHARED C4$, BGC, DOT$πCOMMON SHARED SPACING$, Word$πCOMMON SHARED PFT, PFLπCOMMON SHARED m, d, y, nt%πDIM P$(122)πDIM SHARED ColorprefπDIM SHARED Colors(0 TO 20, 1 TO 4)πDIM SHARED year%(278)πDIM SHARED M1%(12), M2%(12), M3%(12), M4%(12), M5%(12), M6%(12), M7%(12)πDIM SHARED M8%(12), M9%(12), M10%(12), M11%(12), M12%(12), M13%(12), M14%(12)πDIM SHARED d1%(31), d2%(31), d3%(31), d4%(31), d5%(31), d6%(31), d7%(31)πDIM SHARED dn$(7)πDIM SHARED mn$(12): DIM SHARED mnu%(12)πCALL LETTERS                                'CALL LETTERSETπ'π' Begin Mainline Codeπ'πInitializeπOPENINTROπBEGIN:πColorpref = 1πFancyCls Colors(2, Colorpref), Colors(1, Colorpref)πBox 9, 19, 15, 61πCOLOR 7, 0πCenter 11, "Enter the Century and Year (CCYY)"πnt% = 1πy = GetNum#(13, 38)πFancyCls Colors(2, Colorpref), Colors(1, Colorpref)πBox 9, 19, 15, 61πCOLOR 7, 0πCenter 11, "Enter the Month of the Year (01-12)"πnt% = 2πm = GetNum#(13, 39)πFancyCls Colors(2, Colorpref), Colors(1, Colorpref)πBox 9, 19, 15, 61πCOLOR 7, 0πCenter 11, "Enter the Day of the Month (01-31)"πnt% = 3πd = GetNum#(13, 39)πDATEEDIT:πIF m = 2 THENπ   z% = y MOD 4π   IF z% = 0 THENπ       mnu%(2) = 29π   END IFπEND IFπIF d > mnu%(m) THENπ    CALL DAYERRORπ    CALL PAUSEπ    GOTO doagainπEND IFπINDEX1 = (y - BYEAR) + 1πINDEX2 = year%(INDEX1)πSELECT CASE INDEX2π    CASE IS = 1π        index3 = M1%(m)π    CASE IS = 2π        index3 = M2%(m)π    CASE IS = 3π        index3 = M3%(m)π    CASE IS = 4π        index3 = M4%(m)π    CASE IS = 5π        index3 = M5%(m)π    CASE IS = 6π        index3 = M6%(m)π    CASE IS = 7π        index3 = M7%(m)π    CASE IS = 8π        index3 = M8%(m)π    CASE IS = 9π        index3 = M9%(m)π    CASE IS = 10π        index3 = M10%(m)π    CASE IS = 11π        index3 = M11%(m)π    CASE IS = 12π        index3 = M12%(m)π    CASE IS = 13π        index3 = M13%(m)π    CASE IS = 14π        index3 = M14%(m)πEND SELECTπSELECT CASE index3π    CASE IS = 1π        bd% = d1%(d)π    CASE IS = 2π        bd% = d2%(d)π    CASE IS = 3π        bd% = d3%(d)π    CASE IS = 4π        bd% = d4%(d)π    CASE IS = 5π        bd% = d5%(d)π    CASE IS = 6π        bd% = d6%(d)π    CASE IS = 7π        bd% = d7%(d)πEND SELECTπFancyCls Colors(2, Colorpref), Colors(1, Colorpref)πBox 9, 19, 15, 61πCOLOR 7, 0πIF bd% > 7 OR bd% < 0 THENπ   LOCATE 10, 20, 0π   PRINT "Calculation Error - bd%"π   LOCATE 11, 41, 0π   PRINT bd%π   GOTO finishπEND IFπz1$ = mn$(m): z2$ = STR$(d): z3$ = STR$(y): z4$ = z1$ + " " + z2$ + z3$πA$ = "The date entered is a " + dn$(bd%)πCenter 10, z4$πCenter 12, A$πA$ = ""πPAUSEπdoagain:πFancyCls Colors(2, Colorpref), Colors(1, Colorpref)πBox 9, 19, 15, 61πCOLOR 7, 0πCenter 12, "Do another date ? [Y/N]"πLOCATE 14, 40, 1πWHILE INKEY$ <> "": WENDπDOπ   kbd$ = UCASE$(INKEY$)πLOOP UNTIL kbd$ = "Y" OR kbd$ = "N"πIF kbd$ = "Y" THENπ   mnu%(2) = 28π   GOTO BEGINπEND IFπCLSπSYSTEMπfinish:πENDππ'The following data defines the color schemes available via the main menu.π'π'    scrn  dots  bar  back   title  shdow  choice  curs   cursbk  shdowπDATA 0,    7,    15,  7,     0,     7,     0,      15,    0,      0πDATA 1,    9,    12,  3,     0,     1,     15,     0,     7,      0πDATA 3,    15,   13,  1,     14,    3,     15,     0,     7,      0πDATA 7,    12,   15,  4,     14,    0,     15,     15,    1,      0ππ'Box:π'  Draw a box on the screen between the given coordinates.πSUB Box (Row1, Col1, Row2, Col2) STATICπ    COLOR 14, 0π    BoxWidth = Col2 - Col1 + 1ππ    LOCATE Row1, Col1π    PRINT "┌"; STRING$(BoxWidth - 2, "─"); "┐";ππ    FOR A = Row1 + 1 TO Row2 - 1π        LOCATE A, Col1π        PRINT "│"; SPACE$(BoxWidth - 2); "│";π    NEXT Aππ    LOCATE Row2, Col1π    PRINT "└"; STRING$(BoxWidth - 2, "─"); "┘";ππEND SUBππDEFSNG A-Zπ'Center:π'  Center text on the given row.πSUB Center (Row%, text$)πDEFINT A-Zπ    LOCATE Row, 41 - LEN(text$) / 2π    PRINT text$;πEND SUBππSUB DAYERRORπz1$ = STR$(m)πz2$ = STR$(d)πz3$ = STR$(y)πLINE (158, 235)-(390, 249), 7, BπLINE (159, 236)-(389, 248), 15, BFπWord$ = "              " + z1$ + "/" + z2$ + "/" + z3$πSPACING$ = "R0"πSIZE$ = " 4"πDOT$ = "N"πBGC = 15πCALL TRANSLATEπC1$ = "C 4"πC2$ = "C12"πPFT = 245: PFL = 163: CALL NORMAL1πLINE (158, 262)-(390, 274), 7, BπLINE (159, 263)-(389, 273), 15, BFπWord$ = "The day of the month is invalid"πSPACING$ = "R0"πSIZE$ = " 4"πDOT$ = "N"πBGC = 15πCALL TRANSLATEπC1$ = "C 4"πC2$ = "C12"πPFT = 272: PFL = 163: CALL NORMAL1πLINE (158, 279)-(415, 291), 7, BπLINE (159, 280)-(414, 290), 15, BFπx$ = STR$(mnu%(m))πWord$ = "The month you selected has " + x$ + " days"πSPACING$ = "R0"πSIZE$ = " 4"πDOT$ = "N"πBGC = 15πCALL TRANSLATEπC1$ = "C 4"πC2$ = "C12"πPFT = 289: PFL = 163: CALL NORMAL1πLEAPYRERROR:πIF m < 2 OR m > 2 THENπ        GOTO exitsubπEND IFπIF d > 29 THENπ        GOTO exitsubπEND IFπLINE (158, 296)-(415, 308), 7, BπLINE (159, 297)-(414, 307), 15, BFπWord$ = "The year is not a leap year"πSPACING$ = "R0"πSIZE$ = " 4"πDOT$ = "N"πBGC = 15πCALL TRANSLATEπC1$ = "C 4"πC2$ = "C12"πPFT = 306: PFL = 163: CALL NORMAL1ππexitsub:πEND SUBππDEFSNG A-Zπ'FancyCls:π'  Clears screen in the right color, and draws nice dots.πSUB FancyCls (dots%, Background%)πDEFINT A-Zπ    VIEW PRINT 7 TO 25π    COLOR dots, Backgroundπ    CLS 2ππ    FOR A = 560 TO 1820 STEP 45π        Row = A / 80 + 1π        Col = A MOD 80 + 1π        LOCATE Row, Colπ        PRINT CHR$(250);π    NEXT AπEND SUBππ'GetNum:π'  Gets valid numeric input from userπ'Parameters:π'  Row, Col - location to echo inputπFUNCTION GetNum# (Row, Col)π  result$ = ""π  Done = FALSEπ  WHILE INKEY$ <> "": WEND   'Clear keyboard bufferππ  DO WHILE NOT Doneππ    LOCATE Row, Colπ    PRINT result$; CHR$(95); "    ";π    π    kbd$ = INKEY$π    SELECT CASE kbd$π      CASE "0" TO "9"π        result$ = result$ + kbd$π      CASE "."π        IF INSTR(result$, ".") = 0 THENπ          result$ = result$ + kbd$π        END IFπ      CASE CHR$(13)π        IF (VAL(result$) > 2030 OR VAL(result$) < 1753) AND nt% = 1 THENπ          result$ = ""π            CALL inputerrorπ        ELSEπ        IF (VAL(result$) > 12 OR VAL(result$) < 1) AND nt% = 2 THENπ          result$ = ""π          CALL inputerrorπ        ELSEπ        IF (VAL(result$) > 31 OR VAL(result$) < 1) AND nt% = 3 THENπ          result$ = ""π          CALL inputerrorπ        ELSEπ          Done = TRUEπ        END IFπ         END IFπ          END IFπ       π      CASE CHR$(8)π        IF LEN(result$) > 0 THENπ          result$ = LEFT$(result$, LEN(result$) - 1)π        END IFπ      CASE ELSEπ        IF LEN(kbd$) > 0 THENπ          BEEPπ        END IFπ      END SELECTπ  LOOPππ  LOCATE Row, Colπ  PRINT result$; " ";ππ  GetNum# = VAL(result$)π'πEND FUNCTIONππ'Initialize:π'  Read colors in and set up assembly routinesπSUB Initializeπyear%(1) = 1: year%(2) = 2: year%(3) = 3: year%(4) = 11: year%(5) = 6: year%(6) = 7πyear%(7) = 1: year%(8) = 9: year%(9) = 4: year%(10) = 5: year%(11) = 6: year%(12) = 14πyear%(13) = 2: year%(14) = 3: year%(15) = 4: year%(16) = 12: year%(17) = 7: year%(18) = 1πyear%(19) = 2: year%(20) = 10: year%(21) = 5: year%(22) = 6: year%(23) = 7: year%(24) = 8πyear%(25) = 3: year%(26) = 4: year%(27) = 5: year%(28) = 13: year%(29) = 1: year%(30) = 2πyear%(31) = 3: year%(32) = 11: year%(33) = 6: year%(34) = 7: year%(35) = 1: year%(36) = 9πyear%(37) = 4: year%(38) = 5: year%(39) = 6: year%(40) = 14: year%(41) = 2: year%(42) = 3πyear%(43) = 4: year%(44) = 12: year%(45) = 7: year%(46) = 1: year%(47) = 2: year%(48) = 3πyear%(49) = 4: year%(50) = 5: year%(51) = 6: year%(52) = 14: year%(53) = 2: year%(54) = 3πyear%(55) = 4: year%(56) = 12: year%(57) = 7: year%(58) = 1: year%(59) = 2: year%(60) = 10πyear%(61) = 5: year%(62) = 6: year%(63) = 7: year%(64) = 8: year%(65) = 3: year%(66) = 4πyear%(67) = 5: year%(68) = 13: year%(69) = 1: year%(70) = 2: year%(71) = 3: year%(72) = 11πyear%(73) = 6: year%(74) = 7: year%(75) = 1: year%(76) = 9: year%(77) = 4: year%(78) = 5πyear%(79) = 6: year%(80) = 14: year%(81) = 2: year%(82) = 3: year%(83) = 4: year%(84) = 12πyear%(85) = 7: year%(86) = 1: year%(87) = 2: year%(88) = 10: year%(89) = 5: year%(90) = 6πyear%(91) = 7: year%(92) = 8: year%(93) = 3: year%(94) = 4: year%(95) = 5: year%(96) = 13πyear%(97) = 1: year%(98) = 2: year%(99) = 3: year%(100) = 11: year%(101) = 6: year%(102) = 7πyear%(103) = 1: year%(104) = 9: year%(105) = 4: year%(106) = 5: year%(107) = 6: year%(108) = 14πyear%(109) = 2: year%(110) = 3: year%(111) = 4: year%(112) = 12: year%(113) = 7: year%(114) = 1πyear%(115) = 2: year%(116) = 10: year%(117) = 5: year%(118) = 6: year%(119) = 7: year%(120) = 8πyear%(121) = 3: year%(122) = 4: year%(123) = 5: year%(124) = 13: year%(125) = 1: year%(126) = 2πyear%(127) = 3: year%(128) = 11: year%(129) = 6: year%(130) = 7: year%(131) = 1: year%(132) = 9πyear%(133) = 4: year%(134) = 5: year%(135) = 6: year%(136) = 14: year%(137) = 2: year%(138) = 3πyear%(139) = 4: year%(140) = 12: year%(141) = 7: year%(142) = 1: year%(143) = 2: year%(144) = 10πyear%(145) = 5: year%(146) = 6: year%(147) = 7: year%(148) = 1: year%(149) = 2: year%(150) = 3πyear%(151) = 4: year%(152) = 12: year%(153) = 7: year%(154) = 1: year%(155) = 2: year%(156) = 10πyear%(157) = 5: year%(158) = 6: year%(159) = 7: year%(160) = 8: year%(161) = 3: year%(162) = 4πyear%(163) = 5: year%(164) = 13: year%(165) = 1: year%(166) = 2: year%(167) = 3: year%(168) = 11πyear%(169) = 6: year%(170) = 7: year%(171) = 1: year%(172) = 9: year%(173) = 4: year%(174) = 5πyear%(175) = 6: year%(176) = 14: year%(177) = 2: year%(178) = 3: year%(179) = 4: year%(180) = 12πyear%(181) = 7: year%(182) = 1: year%(183) = 2: year%(184) = 10: year%(185) = 5: year%(186) = 6πyear%(187) = 7: year%(188) = 8: year%(189) = 3: year%(190) = 4: year%(191) = 5: year%(192) = 13πyear%(193) = 1: year%(194) = 2: year%(195) = 3: year%(196) = 11: year%(197) = 6: year%(198) = 7πyear%(199) = 1: year%(200) = 9: year%(201) = 4: year%(202) = 5: year%(203) = 6: year%(204) = 14πyear%(205) = 2: year%(206) = 3: year%(207) = 4: year%(208) = 12: year%(209) = 7: year%(210) = 1πyear%(211) = 2: year%(212) = 10: year%(213) = 5: year%(214) = 6: year%(215) = 7: year%(216) = 8πyear%(217) = 3: year%(218) = 4: year%(219) = 5: year%(220) = 13: year%(221) = 1: year%(222) = 2πyear%(223) = 3: year%(224) = 11: year%(225) = 6: year%(226) = 7: year%(227) = 1: year%(228) = 9πyear%(229) = 4: year%(230) = 5: year%(231) = 6: year%(232) = 14: year%(233) = 2: year%(234) = 3πyear%(235) = 4: year%(236) = 12: year%(237) = 7: year%(238) = 1: year%(239) = 2: year%(240) = 10πyear%(241) = 5: year%(242) = 6: year%(243) = 7: year%(244) = 8: year%(245) = 3: year%(246) = 4πyear%(247) = 5: year%(248) = 13: year%(249) = 1: year%(250) = 2: year%(251) = 3: year%(252) = 11πyear%(253) = 6: year%(254) = 7: year%(255) = 1: year%(256) = 9: year%(257) = 4: year%(258) = 5πyear%(259) = 6: year%(260) = 14: year%(261) = 2: year%(262) = 3: year%(263) = 4: year%(264) = 12πyear%(265) = 7: year%(266) = 1: year%(267) = 2: year%(268) = 10: year%(269) = 5: year%(270) = 6πyear%(271) = 7: year%(272) = 8: year%(273) = 3: year%(274) = 4: year%(275) = 5: year%(276) = 13πyear%(277) = 1: year%(278) = 2πM1%(1) = 1: M1%(2) = 4: M1%(3) = 4: M1%(4) = 7: M1%(5) = 2: M1%(6) = 5πM1%(7) = 7: M1%(8) = 3: M1%(9) = 6: M1%(10) = 1: M1%(11) = 4: M1%(12) = 6πM2%(1) = 2: M2%(2) = 5: M2%(3) = 5: M2%(4) = 1: M2%(5) = 3: M2%(6) = 6πM2%(7) = 1: M2%(8) = 4: M2%(9) = 7: M2%(10) = 2: M2%(11) = 5: M2%(12) = 7πM3%(1) = 3: M3%(2) = 6: M3%(3) = 6: M3%(4) = 2: M3%(5) = 4: M3%(6) = 7πM3%(7) = 2: M3%(8) = 5: M3%(9) = 1: M3%(10) = 3: M3%(11) = 6: M3%(12) = 1πM4%(1) = 4: M4%(2) = 7: M4%(3) = 7: M4%(4) = 3: M4%(5) = 5: M4%(6) = 1πM4%(7) = 3: M4%(8) = 6: M4%(9) = 2: M4%(10) = 4: M4%(11) = 7: M4%(12) = 2πM5%(1) = 5: M5%(2) = 1: M5%(3) = 1: M5%(4) = 4: M5%(5) = 6: M5%(6) = 2πM5%(7) = 4: M5%(8) = 7: M5%(9) = 3: M5%(10) = 5: M5%(11) = 1: M5%(12) = 3πM6%(1) = 6: M6%(2) = 2: M6%(3) = 2: M6%(4) = 5: M6%(5) = 7: M6%(6) = 3πM6%(7) = 5: M6%(8) = 1: M6%(9) = 4: M6%(10) = 6: M6%(11) = 2: M6%(12) = 4πM7%(1) = 7: M7%(2) = 3: M7%(3) = 3: M7%(4) = 6: M7%(5) = 1: M7%(6) = 4πM7%(7) = 6: M7%(8) = 2: M7%(9) = 5: M7%(10) = 7: M7%(11) = 3: M7%(12) = 5πM8%(1) = 1: M8%(2) = 4: M8%(3) = 5: M8%(4) = 1: M8%(5) = 3: M8%(6) = 6πM8%(7) = 1: M8%(8) = 4: M8%(9) = 7: M8%(10) = 2: M8%(11) = 5: M8%(12) = 7πM9%(1) = 2: M9%(2) = 5: M9%(3) = 6: M9%(4) = 2: M9%(5) = 4: M9%(6) = 7πM9%(7) = 2: M9%(8) = 5: M9%(9) = 1: M9%(10) = 3: M9%(11) = 6: M9%(12) = 1πM10%(1) = 3: M10%(2) = 6: M10%(3) = 7: M10%(4) = 3: M10%(5) = 5: M10%(6) = 1πM10%(7) = 3: M10%(8) = 6: M10%(9) = 2: M10%(10) = 4: M10%(11) = 7: M10%(12) = 2πM11%(1) = 4: M11%(2) = 7: M11%(3) = 1: M11%(4) = 4: M11%(5) = 6: M11%(6) = 2πM11%(7) = 4: M11%(8) = 7: M11%(9) = 3: M11%(10) = 5: M11%(11) = 1: M11%(12) = 3πM12%(1) = 5: M12%(2) = 1: M12%(3) = 2: M12%(4) = 5: M12%(5) = 7: M12%(6) = 3πM12%(7) = 5: M12%(8) = 1: M12%(9) = 4: M12%(10) = 6: M12%(11) = 2: M12%(12) = 4πM13%(1) = 6: M13%(2) = 2: M13%(3) = 3: M13%(4) = 6: M13%(5) = 1: M13%(6) = 4πM13%(7) = 6: M13%(8) = 2: M13%(9) = 5: M13%(10) = 7: M13%(11) = 3: M13%(12) = 5πM14%(1) = 7: M14%(2) = 3: M14%(3) = 4: M14%(4) = 7: M14%(5) = 2: M14%(6) = 5πM14%(7) = 7: M14%(8) = 3: M14%(9) = 6: M14%(10) = 1: M14%(11) = 4: M14%(12) = 6πdn$(1) = "MONDAY   ": dn$(2) = "TUESDAY  ": dn$(3) = "WEDNESDAY": dn$(4) = "THURSDAY ": dn$(5) = "FRIDAY   ": dn$(6) = "SATURDAY ": dn$(7) = "SUNDAY"πd1%(1) = 1: d1%(2) = 2: d1%(3) = 3: d1%(4) = 4: d1%(5) = 5: d1%(6) = 6:πd1%(7) = 7: d1%(8) = 1: d1%(9) = 2: d1%(10) = 3πd1%(11) = 4: d1%(12) = 5: d1%(13) = 6: d1%(14) = 7: d1%(15) = 1: d1%(16) = 2: d1%(17) = 3: d1%(18) = 4: d1%(19) = 5: d1%(20) = 6πd1%(21) = 7: d1%(22) = 1: d1%(23) = 2: d1%(24) = 3: d1%(25) = 4: d1%(26) = 5: d1%(27) = 6: d1%(28) = 7: d1%(29) = 1: d1%(30) = 2πd1%(31) = 3πd2%(1) = 2: d2%(2) = 3: d2%(3) = 4: d2%(4) = 5: d2%(5) = 6: d2%(6) = 7: d2%(7) = 1: d2%(8) = 2: d2%(9) = 3: d2%(10) = 4πd2%(11) = 5: d2%(12) = 6: d2%(13) = 7: d2%(14) = 1: d2%(15) = 2: d2%(16) = 3: d2%(17) = 4: d2%(18) = 5: d2%(19) = 6: d2%(20) = 7πd2%(21) = 1: d2%(22) = 2: d2%(23) = 3: d2%(24) = 4: d2%(25) = 5: d2%(26) = 6: d2%(27) = 7: d2%(28) = 1: d2%(29) = 2: d2%(30) = 3πd2%(31) = 4πd3%(1) = 3: d3%(2) = 4: d3%(3) = 5: d3%(4) = 6: d3%(5) = 7: d3%(6) = 1: d3%(7) = 2: d3%(8) = 3: d3%(9) = 4: d3%(10) = 5πd3%(11) = 6: d3%(12) = 7: d3%(13) = 1: d3%(14) = 2: d3%(15) = 3: d3%(16) = 4: d3%(17) = 5: d3%(18) = 6: d3%(19) = 7: d3%(20) = 1πd3%(21) = 2: d3%(22) = 3: d3%(23) = 4: d3%(24) = 5: d3%(25) = 6: d3%(26) = 7: d3%(27) = 1: d3%(28) = 2: d3%(29) = 3: d3%(30) = 4πd3%(31) = 5πd4%(1) = 4: d4%(2) = 5: d4%(3) = 6: d4%(4) = 7: d4%(5) = 1: d4%(6) = 2: d4%(7) = 3: d4%(8) = 4: d4%(9) = 5: d4%(10) = 6πd4%(11) = 7: d4%(12) = 1: d4%(13) = 2: d4%(14) = 3: d4%(15) = 4: d4%(16) = 5: d4%(17) = 6: d4%(18) = 7: d4%(19) = 1: d4%(20) = 2πd4%(21) = 3: d4%(22) = 4: d4%(23) = 5: d4%(24) = 6: d4%(25) = 7: d4%(26) = 1: d4%(27) = 2: d4%(28) = 3: d4%(29) = 4: d4%(30) = 5πd4%(31) = 6πd5%(1) = 5: d5%(2) = 6: d5%(3) = 7: d5%(4) = 1: d5%(5) = 2: d5%(6) = 3: d5%(7) = 4: d5%(8) = 5: d5%(9) = 6: d5%(10) = 7πd5%(11) = 1: d5%(12) = 2: d5%(13) = 3: d5%(14) = 4: d5%(15) = 5: d5%(16) = 6: d5%(17) = 7: d5%(18) = 1: d5%(19) = 2: d5%(20) = 3πd5%(21) = 4: d5%(22) = 5: d5%(23) = 6: d5%(24) = 7: d5%(25) = 1: d5%(26) = 2: d5%(27) = 3: d5%(28) = 4: d5%(29) = 5: d5%(30) = 2πd5%(31) = 7πd6%(1) = 6: d6%(2) = 7: d6%(3) = 1: d6%(4) = 2: d6%(5) = 3: d6%(6) = 4: d6%(7) = 5: d6%(8) = 6: d6%(9) = 7: d6%(10) = 1πd6%(11) = 2: d6%(12) = 3: d6%(13) = 4: d6%(14) = 5: d6%(15) = 6: d6%(16) = 7: d6%(17) = 1: d6%(18) = 2: d6%(19) = 3: d6%(20) = 4πd6%(21) = 5: d6%(22) = 6: d6%(23) = 7: d6%(24) = 1: d6%(25) = 2: d6%(26) = 3: d6%(27) = 4: d6%(28) = 5: d6%(29) = 6: d6%(30) = 7πd6%(31) = 1πd7%(1) = 7: d7%(2) = 1: d7%(3) = 2: d7%(4) = 3: d7%(5) = 4: d7%(6) = 5: d7%(7) = 6: d7%(8) = 7: d7%(9) = 1: d7%(10) = 2πd7%(11) = 3: d7%(12) = 4: d7%(13) = 5: d7%(14) = 6: d7%(15) = 7: d7%(16) = 1: d7%(17) = 2: d7%(18) = 3: d7%(19) = 4: d7%(20) = 5πd7%(21) = 6: d7%(22) = 7: d7%(23) = 1: d7%(24) = 2: d7%(25) = 3: d7%(26) = 4: d7%(27) = 5: d7%(28) = 6: d7%(29) = 7: d7%(30) = 1πd7%(31) = 2πmn$(1) = "January": mn$(2) = "February": mn$(3) = "March": mn$(4) = "April": mn$(5) = "May": mn$(6) = "June"πmn$(7) = "July": mn$(8) = "August": mn$(9) = "September": mn$(10) = "October": mn$(11) = "November": mn$(12) = "December"πmnu%(1) = 31: mnu%(2) = 28: mnu%(3) = 31: mnu%(4) = 30: mnu%(5) = 31: mnu%(6) = 30: mnu%(7) = 31: mnu%(8) = 31: mnu%(9) = 30: mnu%(10) = 31: mnu%(11) = 30: mnu%(12) = 31ππFOR ColorSet = 1 TO 4π     FOR x = 1 TO 10π            READ Colors(x, ColorSet)π     NEXT xπNEXT ColorSetππEND SUBππSUB inputerrorπLINE (158, 235)-(390, 249), 7, BπLINE (159, 236)-(389, 248), 15, BFπWord$ = "Input Error"πSPACING$ = "R0"πSIZE$ = " 4"πDOT$ = "N"πBGC = 15πCALL TRANSLATEπC1$ = "C 4"πC2$ = "C12"πPFT = 245: PFL = 163: CALL NORMAL1πLINE (158, 262)-(390, 274), 7, BπLINE (159, 263)-(389, 273), 15, BFπIF nt% = 1 THENπ   Word$ = "The Year entered is invalid"πELSEIF nt% = 2 THENπ   Word$ = "The Month entered is invalid"πELSEIF nt% = 3 THENπ   Word$ = "The Day entered is invalid"πEND IFπSPACING$ = "R0"πSIZE$ = " 4"πDOT$ = "N"πBGC = 15πCALL TRANSLATEπC1$ = "C 4"πC2$ = "C12"πPFT = 272: PFL = 163: CALL NORMAL1πLINE (158, 279)-(415, 291), 7, BπLINE (159, 280)-(414, 290), 15, BFπIF nt% = 1 THENπ    Word$ = "Valid range is 1753 - 2030"πELSEIF nt% = 2 THENπ    Word$ = "Valid range is 1 - 12"πELSEIF nt% = 3 THENπ    Word$ = "Valid range is 1 -31"πEND IFπSPACING$ = "R0"πSIZE$ = " 4"πDOT$ = "N"πBGC = 15πCALL TRANSLATEπC1$ = "C 4"πC2$ = "C12"πPFT = 289: PFL = 163: CALL NORMAL1πLINE (158, 296)-(415, 308), 7, BπLINE (159, 297)-(414, 307), 15, BFπWord$ = "Please re-enter"πSPACING$ = "R0"πSIZE$ = " 4"πDOT$ = "N"πBGC = 15πCALL TRANSLATEπC1$ = "C 4"πC2$ = "C12"πPFT = 306: PFL = 163: CALL NORMAL1ππEND SUBππSUB LAYER1π  PSET (PFL + 2, PFT + 5), BGC: DRAW C3$ + P$π  PSET (PFL + 0, PFT + 5), BGC: DRAW C3$ + P$π  PSET (PFL + 1, PFT + 5), BGC: DRAW C3$ + P$π  PSET (PFL + 0, PFT + 4), BGC: DRAW C3$ + P$π  PSET (PFL + 1, PFT + 2), BGC: DRAW C2$ + P$π  PSET (PFL + 2, PFT + 4), BGC: DRAW C1$ + P$π  PSET (PFL + 3, PFT + 3), BGC: DRAW C4$ + P$π  PSET (PFL + 3, PFT + 2), BGC: DRAW C2$ + P$π  PSET (PFL + 4, PFT + 4), BGC: DRAW C2$ + P$π  PSET (PFL + 5, PFT + 2), BGC: DRAW C3$ + P$π  PSET (PFL + 5, PFT + 3), BGC: DRAW C2$ + P$π  PSET (PFL + 4, PFT + 3), BGC: DRAW C1$ + P$πEND SUBππSUB LETTERSπ   P$(32) = "BR4"                                                  'SPACEπ   P$(33) = "BR1BD1U1BU2U5BD7BR3"                                  '!π   P$(34) = "BR0BU7D2BR2U2BD7BR3"                                  '"π   P$(35) = "BD1BR1U8D2L1R5L1U2D8U2L4R5BR2BD1"                     '#π   P$(36) = "BD1BR3U8D8BL3BU5U1E1R3F1BD1BL5F1R3F1D1G1L3H1BR7BD1"   '$π   P$(37) = "BD1U1E6U1BL5BD2U1R1D1L1BD4BR4R1D1L1U1BD1BR5"          '%π   P$(38) = "BR1BU2BL1E3U1H1L1G1D1F6BU1BL5BU3G2D1F1R3E3BD2BR2"     '&π   P$(39) = "BR2BU7D1G1BD5BR4"                                     ''π   P$(40) = "BR1BD1BU2U4E2G2D4F2BU1BR4"                            '(π   P$(41) = "BR2BD1BU2U4H2F2D4G2BU1BR5"                            ')π   P$(42) = "BR2BU2U6D3L2R4BL4BD2E4BL4F4BD3BR4"                    '*π   P$(43) = "BR2BD1U7D3L2R5BD3BR3"                                 '+π   P$(44) = "BD1U1R1D2G1BU3BR4"                                    ',π   P$(45) = "BR1BU3R3L3BD3BR5"                                     '-π   P$(46) = "BD1BR1L1BU1BR4"                                       '.π   P$(47) = "BR1E5G5BR7"                                           '/π   P$(48) = "BD1BU1U6E1R2F1D6G1L2H1BR6"                            '0π   P$(49) = "BD1BR2U7BL1E1D1BD6BR3"                                '1π   P$(50) = "BR1BU6E1R2F1D2G4D1R4BU1BR3"                           '2π   P$(51) = "BU6E1R2F1D2G1L2R2F1D2G1L2H1BR7"                       '3π   P$(52) = "BU3E4D8U4L4R5BD3BR3"                                  '4π   P$(53) = "BR1BU3U4R4L4D4E1R2F1D3G1L2H1BR7"                      '5π   P$(54) = "BR1BD1BU4U3E1R2F1H1L2G1D6F1R2E1U3H1L2G1BD3BR6"        '6π   P$(55) = "BR1BU7R4D3G4D1BU1BR7"                                 '7π   P$(56) = "BR1BU6E1R2F1D2G1L2R2F1D2G1L2H1U2E1H1U2BD6BR7"         '8π   P$(57) = "BR1BU4U2E1R2F1D6G1L2H1BU4F1R3BD3BR3"                  '9π   P$(58) = "BR1U1BU2U1BD4BR3"                                     ':π   P$(59) = "BD1BR1BU1U1BU2U1BD4G1BU1BR6"                          ';π   P$(60) = "BU3E3G3F3BR3"                                         '<π   P$(61) = "BU3R4BD2L4BR7BD1"                                     '=π   P$(62) = "BU6BR1F3G3BR5"                                        '>π   P$(63) = "BR1BU5U1E1R2F1D2G1D1BD2D1BU1BR3"                      '?π   P$(64) = "BD1BU1U6E1R3F1D5L2H1U2E1R1D3BD3L3H1F1R3E1BR3"         '@π   P$(65) = "BD1U7E1R3F1D3L5R5D4BR4BU1"                            'Aπ   P$(66) = "BD1U8R4F1D2G1L4R4F1D2G1L4BU1BR9"                      'Bπ   P$(67) = "BD1BU1U6E1R3F1BD6G1L3H1F1R3BR4BU1"                    'Cπ   P$(68) = "BD1U8R4F1D6G1L4BR9BU1 "                               'Dπ   P$(69) = "BD1U8R4L4D4R3L3D4R4BU1BR4"                            'Eπ   P$(70) = "BD1U8R5L5D4R4L4D4BR8BU1"                              'Fπ   P$(71) = "BD1BU1U6E1R3F1BD6G1L3H1F1R3E1U3L2R2D3BR4"             'Gπ   P$(72) = "BD1U8D4R4U4D8BR4BU1"                                  'Hπ   P$(73) = "BD1BR3U8L1R2L1D8L1R2BR4BU1"                           'Iπ   P$(74) = "BD1BU1F1R2E1U7L1R2L1D7BR5"                            'Jπ   P$(75) = "BD1BU8D8U4R1E4G4F4BR4BU1"                             'Kπ   P$(76) = "BD1BU8D8R4BU1BR4"                                     'Lπ   P$(77) = "BD1U7E1R2F1D7U7E1R2F1D7BU1BR4"                        'Mπ   P$(78) = "BD1U8F7D1U8D8BR4BU1"                                  'Nπ   P$(79) = "BD1BU1U6E1R3F1BD6G1L3H1BR5U6D6BR4"                    'Oπ   P$(80) = "BD1U8R4F1D2G1L4D4BR9BU1"                              'Pπ   P$(81) = "BD1BU1U6E1R3F1BD6G1L3H1BR5U6BL3BD5F3BG3BR7BU5"        'Qπ   P$(82) = "BD1U8R4F1D2G1L4R1F4BR4BU1"                            'Rπ   P$(83) = "BD1BU5U2E1R3F1BD2BL5F1R3F1D2G1L3H1BR9"                'Sπ   P$(84) = "BR3BD1BU8L4R6L3D8BR6BU1"                              'Tπ   P$(85) = "BD1BU1U7D7F1R3E1U7D7BR4"                              'Uπ   P$(86) = "BD1BU8D5F2D1U1E2U5D5BR5BD2"                           'Vπ   P$(87) = "BD1BU1U7D7F1R2E1U7D7F1R2E1U7D7BD1BR4BU1"              'Wπ   P$(88) = "BD1BU8D1F3E3U1D1G6D1U1E3F3D1BU1BR5"                   'Xπ   P$(89) = "BL1BU5U2D2F3E3U2D2G3D3BU1BR7"                         'Yπ   P$(90) = "BU7R5D2G5D1R5BR4BU1"                                  'Zπ   P$(91) = "BR1BD1BR3L3U8R3BR3BD7"                                '[π   P$(92) = "BU5F5BR3"                                             '\π   P$(93) = "BD1R3U8L3BR2BD7BR4"                                   ']π   P$(94) = "BR1BU5E2F2BD5BR2"                                     '^π   P$(95) = "BD1R4BU1BL2BR5"                                       '_π   P$(96) = "BR2BU7D1F1BD5BR2"                                     '`π   P$(97) = "U2E1R3U1H1L2G1E1R2F1D4G1L2H1F1BR2E1U2D3BR4BU1"        'aπ   P$(98) = "BD1U8D8R3E1U4H1L2G1D4BR8"                             'bπ   P$(99) = "BR0U4E1R2F1BD4G1L2H1F1R2E1BR4"                        'cπ   P$(100) = "U4E1R2F1H1L2G1D4F1R2E1U7D7D1BU1BR4"                  'dπ   P$(101) = "U4E1R2F1D2L4D2F1R2E1BR4"                             'eπ   P$(102) = "BR1BD1U7E1R2F1H1L2G1D3L1R3BD3BR5"                    'fπ   P$(103) = "U4E1R2F1D4G1L2H1BD3F1R2E1U3BR4"                      'gπ   P$(104) = "BU7D8U5E1R2F1D5BU1BR4"                               'hπ   P$(105) = "BR3BD1U6BU2BD7BR4"                                   'iπ   P$(106) = "BR1BD1U6BU2BD7D3G1L2BU4BR8"                          'jπ   P$(107) = "BD1BU8D8U3E3G3F3BU1BR3"                              'kπ   P$(108) = "BR1BD1U8L1R1D8L1R2BR4BU1"                            'lπ   P$(109) = "BD1U6D1E1R1F1D5U5E1R1F1D5BU1BR4"                     'mπ   P$(110) = "BD1U6D1E1R2F1D5U4BD3BR4"                             'nπ   P$(111) = "U4E1R2F1D4G1L2H1BR8"                                 'oπ   P$(112) = "U4E1R2F1D4G1L2H1D4U4BR8"                             'pπ   P$(113) = "U4E1R2F1D4G1L2H1BR4D4L1R2L1U4BR5"                    'qπ   P$(114) = "BD1U6D1E1R2F1H1L2G1U1D6BU1BR7"                       'rπ   P$(115) = "BU3U1E1R2F1H1L2G1D1F1R2F1D1G1L2H1BR8"                'sπ   P$(116) = "BR1BU7D2L2R4L2D5F1R1E1BR4"                           'tπ   P$(117) = "U5D5F1R2E1U5D5BR4"                                   'uπ   P$(118) = "BD1BU6D3F2D1U1E2U3D3BD2BR4"                          'vπ   P$(119) = "BD1BU6D5F1R1E1U4D4F1R1E1U5D5BR4"                     'wπ   P$(120) = "BD1BU6D1F2E2U1D1G4D1U1E2F2D1BU1BR4"                  'xπ   P$(121) = "BU5D5F1R2E1U5D8G1L2H1BU3BR8"                         'yπ   P$(122) = "BU5R4D1G4D1R4BU1BR4"                                 'zπEND SUBππSUB NORMAL0πPSET (PFL + 0, PFT + 0), BGC: DRAW C1$ + P$πEND SUBππSUB NORMAL1π    PSET (PFL + 0, PFT + 1), BGC: DRAW C2$ + P$π    PSET (PFL + 1, PFT + 0), BGC: DRAW C1$ + P$π    PSET (PFL + 2, PFT + 0), BGC: DRAW C1$ + P$πEND SUBππSUB OPENINTROπCOLOR 7, 0πSCREEN 9                                    'SET SCREEN MODE TO 9πCLSπLINE (1, 1)-(590, 72), 13, BπLINE (3, 3)-(588, 70), 7, BFπWord$ = "What Day Was It ?"πSPACING$ = "L1"πSIZE$ = "20"πDOT$ = "N"πBGC = 7πCALL TRANSLATEπC1$ = "C 5": C2$ = "C 8": C3$ = "C 8": C4$ = "C 8"πPFT = 52: PFL = 16: CALL LAYER1πPFT = 52: PFL = 14: CALL LAYER1πPFT = 52: PFL = 12: CALL LAYER1πC1$ = "C 5": C2$ = "C 0": C3$ = "C 0": C4$ = "C15"πPFT = 50: PFL = 18: CALL LAYER1πPFT = 50: PFL = 17: CALL LAYER1πColorpref = 1πFancyCls Colors(2, Colorpref), Colors(1, Colorpref)ππLINE (158, 100)-(390, 116), 7, BπLINE (159, 101)-(389, 115), 15, BFπWord$ = "Display Any Day of the Week for"πSPACING$ = "R0"πSIZE$ = " 4"πDOT$ = "N"πBGC = 15πCALL TRANSLATEπC1$ = "C 1"πC2$ = "C 9"πPFT = 110: PFL = 163: CALL NORMAL1πLINE (158, 122)-(390, 138), 7, BπLINE (159, 123)-(389, 137), 15, BFπWord$ = "   Any Date Between 1753 - 2030"πSPACING$ = "R0"πSIZE$ = " 4"πDOT$ = "N"πBGC = 15πCALL TRANSLATEπC1$ = "C 1"πC2$ = "C 9"πPFT = 132: PFL = 163: CALL NORMAL1ππHITENTER:πLINE (228, 337)-(340, 350), 7, BFπWord$ = "Press any Key"πSPACING$ = "R1"πSIZE$ = " 4"πDOT$ = "N"πBGC = 15πCALL TRANSLATEπC1$ = "C 0"πC2$ = "C 8"πPFT = 346: PFL = 231: CALL NORMAL1πINKEY1:πC1$ = "C 0"πC2$ = "C 8"πPFT = 346: PFL = 231: CALL NORMAL1πSLEEP 1πC1$ = "C 4"πC2$ = "C 8"πPFT = 346: PFL = 231: CALL NORMAL1πSLEEP 1πA$ = INKEY$: IF A$ = "" THEN GOTO INKEY1πEND SUBππSUB PAUSEπLINE (248, 337)-(360, 350), 7, BFπWord$ = "Press any Key"πSPACING$ = "R1"πSIZE$ = " 4"πDOT$ = "N"πBGC = 15πCALL TRANSLATEπC1$ = "C 0"πC2$ = "C 8"πPFT = 346: PFL = 251: CALL NORMAL1πINKEY2:πC1$ = "C 0"πC2$ = "C 8"πPFT = 346: PFL = 251: CALL NORMAL1πSLEEP 1πC1$ = "C 4"πC2$ = "C 8"πPFT = 346: PFL = 251: CALL NORMAL1πSLEEP 1πA$ = INKEY$: IF A$ = "" THEN GOTO INKEY2πEND SUBππSUB TRANSLATEπ  SPACING$ = "B" + UCASE$(SPACING$)π     SIZE$ = "S" + UCASE$(SIZE$)π  P$(105) = "BR0BD1U6BU2BD7BR4"                     'iπ  P$(106) = "BR1BD1U6BU2BD7D3G1L2BU4BR8"            'jπ  IF DOT$ = "Y" THEN P$(105) = "BR0BD1U6BU1U1BD7BR4"            'DOT OVER iπ  IF DOT$ = "Y" THEN P$(106) = "BR1BD1U6BU1U1BD7D3G1L2BU4BR8"   'DOT OVER jπ  P$ = SIZE$π  FOR J = 1 TO LEN(Word$)π  P$ = P$ + P$(ASC(MID$(Word$, J, 1))) + SPACING$π  NEXT JπEND SUBπAndrew Jones                   RAD VGA/ANSI DEMO              FidoNet QUIK_BAS Echo          02-11-96 (04:57)       QB, QBasic, PDS        194  12828    RADDEMO.BAS '∙·...............[]RadDemo by Lord Humongous(Andrew Jones)[]...............·∙π'∙    RadDemo...Demo/Intro/Dentro...Released in Quik_BAS GTNet/Fidonet(?)    ∙π'·∙·∙·∙·∙·∙·∙·∙·∙·∙·∙·∙·∙·∙·∙·∙·∙·∙·∙·∙·∙·∙·∙·∙·∙·∙·∙·∙·∙·∙·∙·∙·∙·∙·∙·∙·∙·∙·∙·π'        Welcome to another QuickBASIC VGA demonstration.  While BlueWorldπ'was intended for release as an .EXE file used to demonstrate QB's capability,π'RadDemo is intentionally released as source code for others to look atπ'(and learn from I suppose?)  RadDemo is 100% QuickBASIC, and is completelyπ'commented, something I rarely do, but most of its history and documentationπ'is in the RAD.BAS file itself.  You will have no trouble reading this code!ππ'        RadDemo draws all of the still graphics on the screen and thenπ'begins to animate them...  The slats are animated with simple OUT commandsπ'as well as the "copper/raster bars" so called because of the old Amigaπ'"Copper Chip" which has been much emulated on the IBM.  The stars provideπ'a nice display as well as a good mechanism for slowing this demo down forπ'your computer.  Since this demo was written on a 386/16sx, you will noticeπ'that it flickers beyond belief, and it basically blows when viewed at suchπ'as fast rate.ππDEFINT A-Z:DIM SHARED K,S,B&,Z&:V1 'Created by PostIt! 7.2πSUB V1:OPEN "O",1,"RADSRC.ZIP",4^6:Z&=8420:?STRING$(50,177);πU"%up()%9%%%#-%N,IqEPV%FD^,7%%<4%%%,%%%%wf%iSitOh&&<>>TA6fwsOxh0;πU"o)t[c>*LS8a-Q(.;..sj2L?/(bF(-Y:^s7p-ULJEfeQRX)oT8Hr?-aESN?KB^p'πU"(/1NOIph6qmH^#XtL#n0pD=iMMPtP.z(NX^[VDcQKa\xcVaq$U;Fi&brJB8uxiRπU"BmtDL]4HIv*8opuZh*9>FTe'rZ6'VogBZU,x$Z<R0ix+kV<;z4PZm,h4jsIMm3$πU"2UF]1tDx>^xK)-SH$y\hN651&p\TKIWb;dpqe$Qip&6e_8#f05:-?Cbt8T%y-0zπU"0\$2z\mK$Z0A&^_mLtO?2Q\=&A,<?uYfx1SgZnxR7zWMH4G5,A+^AiJ\%wnXk[LπU"sLP+/w;S%MNC9)^\_+xT1F#X^+bPP22?G4E;Sgtb$IF^I.z)0<r.1p?Dz^>VQbQπU"9AbbGbX2KIC(nrBdIptiIr9KhSMf=F)lV(+SJ<w8>-I/H[Me=6?)yb5c?HU;:_WπU"f^Fl\/p./2B&9cC9:qbY=:501^i4gAA/R_C/$Ni)wZBM)b[ofFgF6-&>4r6qL1QπU"Yk2DbH<+.dmbc_alp2#:$7m]G8:/K[aR<E%w/hm^UJ/0DQq3?ua8iD:T#xA,q)(πU"VA;aIC^l7r1$M-._AZAgb=$iKa<YIDa)PdW$*1JZ02Yp-if_[Ka\T_EIqzplG(ZπU"a)8'.d3dnmY4pwS,;+qM3$T7k^?5%C\mYb<l?F5G0(jB;]qL<sYrm8i6%ibN'OgπU"O_8VJ)S-FJSbhPNCiJh%Hv'RgXS+3(oX++I1*;[rBp=%4EP+>a7CN,3T:l,b,FsπU"l0&Y8qe<hIMf]2(4nd_<:)b+5$FP6Lamip9uZr,Rb56g01Ir<*<+aJn8A.-tpkVπU".aRJexGTY\J%XPa1=b3Jb3sD5p/%:i[YND3?T#u#^Y:\$9fn#ZN1+&'9\7DPrjNπU"YFh'Xdy8QDk].+B;pf<1s_q93E&tJ[^J'nKQ$*E'3RLRGU29GZPt$Y56vAdnn]IπU"d1U,Z:adsDH1FlTi$P(S/kZ[+*q4A,BSB1idQr=FPPXF-L8X4o?qqZxmwTpDo-0πU"-Lqm9hLjkGTQOeq<p'oL;v.IPydATbeLS_[oKYbC3k+jJwP*;E,i>f&dD*]b:crπU"JQ<j2&\D>vgMTd1t0i]U%s/2Z'ccp+#uZp[kZggkU=8;oe2,EU90ZsE%,?F>9m9πU"1:f9kS_7+xG2b-)?B9dZ4t5hVZSSL7>Bb>$P%Cu2P[3fK=.E'S9yQADmFO24^4VπU"7[f?7Qw^#NH$kf?C0G^7(j6<Umd^roikY+u6'8=+i'a-0kPWnqOv3?CBn]AkR?lπU"t%R>_6?V?IK5DezDIc):a\3;/4]ihHS?=SNrdSuU+NWX-WmPN0&uM:l6&'0Wri7πU"zFR4;l>23k/*)#XV\IT%F%?npg<m]cFrI#kY$no3U&\wTU_cynv<#9P=QI2cSg_πU"72$fOR%[VfiS4[1>&Y6[ragu]t,HgE&m.l51tN+B/cB&q&$,578j%P:E7a<ev4nπU"+$S&,<o8KMdjUGRRPG'Pr<CkQ<htDu-NhE:TNTlMf+Ye(;VF8aCRW&*'t8C>DHUπU"7W4D*<pFbDi.j&k1CPC9VospY)1;VL_T45=7+3<aZ4^]rZ$B5i4.3,Zu&6qe-%fπU"NS)37Q4oKLm;fPr^<q*TNaFf]^ZRcO^u9YmK:=:S]Ogq^d;cJ:Vrj\A;jIXTKNKπU"Z-YAqih+8FZ3PSEWUCJD()gX2lV:*.C.KkD9(xJRnm\_8BE%D[,DMmoqe8J565CπU"3o0q3qV_0^H\5EA3pg;j)R(?hBBrU4l)G?LaInc#Q)S=SYHHQYHH41g=?5GNRl9πU"w?%K*Jgdqv/xcs=9%YUBePdjYR9,/rhuP-6Hx/m$_VE;^s;9qqZGenf%b:P'2$#πU"$$B*()B3\r&Qu9$EgE$xSg7cN.Zu:T-N$Jiu=GO5P:%4mDV91<pea-tqi+;?>SRπU"DPLNr%7T2wS))ZYQfJcuWy_9I)W3ne3*GzAqZ(7Vp1*hNFcg2H<5.$)-Mu36jJ[πU"E_\S>ZE#rm(fM7FUovdXQ4*3^v3j8Qa%X1S+vG\UW%]5.YdhDE<qKL%.5;k6QULπU"V,$2TOEbG\p2VSy/<*q$N+Q=Wlct#f8rgNvkqn.wv+du2%.'BgfuT^8ourJJF?^πU">e,:7.Z5HY0W'fA28K.A^'Q8=lXa/LchdDnnCNZ:YjzWV/EdYd-tMVK0>U.GVIVπU"CdlahSnah#:k^X9R,-(T(kMtfsb367YhUuCP?itHjkqqD414o<F;'Z]07^LVp^HπU"s[a48/j8D\1;&>b*f7FQ.C'FttLWl6lvkn<KVG\XAXh0I.kC%YP0DKv$OlwVA5eπU"NL\,7$18uF/fyAhU.wS2,MiK'x*up%()9%%%%-%)GtZEVRb_u%>(%%&v4%%%,%%πU"%%wfiS[ify6k&:]L.U5<#(j#xzErToJai[P1Bi>m*:.#QGR),wU.t=JT?UY)d7&πU"k[p>_)\qLa>;FeF^oC&\X>tTWaH[CLN[.(\jT8M\ECrj4<]-r.*0nG0QR<uNVWgπU"QVWV0lp-vWZo'p03QmI_$Sr$sOUe$]9c>'hbj,K>a&k:HRm$42VS7B]$8-a^i$FπU"=/H*WTeS(C$QqP(G3Lw]>f.-N(&?(fa4.nWB5cwLaX9lxXjs9w9H*uPR0oH6Z:*πU"*=,-R&&D<3mAV$YSa[D>(,ULK5Pq]f.0S[0fa6t&y-&jta490E_]%nrhMXaknYzπU"DQWq[';r*2q:PxPA5u$ihF<p<ECc(iK#j1.CSX8B.*BZ2AnGk1%L:KRL1BVg^WeπU"rU,ZX.J(SPSjQ]AX_G>e-SfiUw,?pA&uZL#x'\0am?r>Z/_jQ_+3I?o5ikfl\6#πU"PdU\%miZJUVX'^FcCuQ[rh/:l31%Ixi?nz]-('R^_^tZ_jyg>kak7:lM&4If<5*πU"hOBrpVNszvLN&TPo2pBXvnYz7Md<2kj^468Ht>9n(a:dCuv)$>W\G$8:dbW&?PCπU"0m*D3/,kDkdl&\fD-tNdZ\&wCi;kHFJsXNgIyb-u&HX#WitsqX6ks'p^qpA),aHπU"gE=6^f)5Cgpon,/SpDcn^m?g2<7>nC$>\)Y4<1zn,*'aD)s>+sW8pQh&>9\WE(gπU"Lwp]ggTnOtvPW\m+gf)\yN2\S)VJ0c4ww5nj[([I*g'W4\Sb3+%5/jylQlnqcTSπU"Kr[:BE(qs.gegn*Q/>[jc#bKTHKu:v9h8s(*aOj+=b+DR;L_D/iF#VscPt(b5F/πU"Y;/ADWac.m&.]cQnbkfvP&Wnvs+8.QuY=4<<9,Mb_a?psF]rZl%8?&wMJTXywehπU"LHiXp4jZ.p^h0_jW5nGb0o^E#crLBp[F<4ob7gHi<<_Xni\<BK5/FFTLll0i1gfπU"L_8Fd-QswEN,.xcON8:1lNumGGpSJdeJVnE9KoZFZl5jLrQ88N*3XfN&%up()%9πU"%%%%-%XL.pE\u5)%=:7%%Oa%%%,%%%%wf%iSgfFx&$NYBSAaux4CX>p\D*9Q-;4πU"R8$RD?/):V;><i'k(hJnGy'+8(%lJ2hv$[Br$JxWj\1ytpK*PV[H..)-\V0zp+rπU"bglbb.LfVXcwrp^xr?\4uB^Cck;Qbo=U(U,hLS?g2QE8xe9a5p''=za9ziez/'VπU"1\9?4#Ct-#Ji/u^7ST7+o$:e;(ZI;-S(%qd;75C?lMC2l_i:eZSp$lb#x'__p'SπU"UClq'](ii_/4j]y%n1rl:F1$3+h*QkF/sB80)C;Teh7'wI3vyQmbGW?-.BGHI*GπU"cel7GiIu0amUU9>T^->(iUMokIQC+x_Ni706:y9>&G5%Tf)3C]9:';O;1#8IwQ0πU"ST9;YRjx(sQ$Jv%T7)6WCHkjfTxXO$\HI'P1<$Ce&JGoKWjc36k1p=YC--xT*$bπU"4W<9TSoAH-Y&(+KKA,+8#UDWYH'H2J'776ql:8$?SM)-c:nf9W2-2='z=N-cWQPπU";Kr3nXItU[GvApCM[uK8,820539QjE5w&+1QsL4\=iX\ZPlBl4jX?G;'W^wg+wiπU"AfEM?6Y$dD^::sjbk<i.xcv(OwDLn4sEPJil+GHM*6]W#u(bwgZARm^15,<4?[$πU"KNFdy-pmYsIKQ'N':isWv(Q'^jHVK+zrauWq;A]7X=4%M.WU:lpg'L:P-W/JnEmπU"'/h7YVEyl9(e9Qm^$cW)$q#[\gWci5<Y-'.O#rb3b&W_*'R'Fya.K7Y%mIJY'&(πU"LK<foS5,JZk?$jqmr(ZAn6rU:kRG.H,AqtHF=lAqyl#p4.TDwJ\_<IVIjAd$.O/πU"zd%%*st,.6;LY17R%rMEutL\.]6S1bfv*bhgTP(NAov:WaXIR##:iBQ^D?<JPKbπU"fVpS.OH2s6xKxBf=\Z%j1='fZ#'jjGlGA?4%./AF[+h%E'>.S1=>&tsH(liHy9'πU"LOl%Uh>v[UFB3ToG0caurmduPQ6x>^lG=;+r',0],(u#sK1.BYoatte^0h/y:E'πU"Cw=u1S6eGK8Yk7-B$SNa-ImwoSvkoc.SH)TCJ[_,oqNq0[ta\LTg3#w,/^TH&m3πU"<D;aE<W.O98Vi^xsQc;:(n*ry'f9etj&NChLl3%%U_e\&L\0LKy>+yf+[q(;tmAπU"L.Fh_pTEfmrN%-HcnI9')3wn/pe_>tY%A0Lv$qdbXt?K'3wp^MZ8cd2<r9.4h43πU")%)>,39G:ZgeWL*racc.^9GFKq7QnQIu+I6#o.>#=Q^UpM\8afKTITrok2S-A[pπU"yAS^7%OoOAS;=N7++P*o$x>J)m<Yeg9oBsmgU91v.#niEf:4BJ?a0<X:Sp$iz1eπU">Dft,qi=h+Cdgevos4sxc[3Xcu:qD2AX*uE_1vCwDJt]5)bGgM?t(0+(STHLfkVπU"Qk'Oe\9;z:SR0o2CalhStv2IJ?QVr*Z$k0e]V^EJHMYgkpphL(]RgoEUoIcBh\tπU"Ft*jRpMLM#6kSy-[F;i6#ek+$,Nh:t7Md;4EoHGHMOEB;O#[%O\C#6n:W4.JYhYπU"hdA<;rZg[oZS#l\C83w1e#4jxzY$_Vil%*2/Zdn<RAC7]RUKMf.i;>lduk>i_nuπU"Xa7H'9L7iM0AN[#e3+R%wY(05SKrqa[v(fK^\'A\L;xg]=7:PcX<MkFq,[U$c3=πU"RM^;$Ua;.+FKRs$0=w8Ic:h[8a$uSj7Bo0ol4Xqi=%H5oHv9346[Ylf$xuXbW:RπU"i1q(oZ5)[U/^#=cr6'oAX*\-S$VrWspte3D$$Q1R0U,A*mc[k*7s3*kif)4f)bpπU"T8q65W+M&6CXZMBs*M2FWjGi9v'-0LoRZ70L<oJ/Uqxj<r6Gwq%Y;v9Hjl\-'W>πU"hSNUbL*g\34EEbXwu<l(Kme>e<DR+qILC4qqG30?CSV\vNWmG0')U9C/UDv?8X#πU"if&5-nV,$\Zv(^\OkdV*'8LNg?MR^Mjmr4aCt#Ow.O_IMn)o<tddCDc0cO#dl'PπU"cY3daC6dmioFWOKX&SA:/U5>63XGd-\_p4_FdTEm'>feS1,7=O+f;ZQ=8=<(82GπU"Z\;D<;CHfeo6N>Z[MjkWVi;q&bK4rI-BCCs4b-V$>IZn9bSVnS3COEVL-bOAzQ^πU"$Y1YF+hM0%V'qfE84(HIwvPXk;DNK)C7wWe>8bKK$#pvlx6T?P51NhVR7Ob>l%YπU"gcl2L,4ojllGdV;>W4BNFj,,hQibGieeJBIPN\-=KGRW#Cp6DlvVfJ2Mn\Ev:sTπU"688%SQIB1_IJ)Alf?:2Mq3[D,'?;?E$/I7W'Na8Pt)<c2s)kZ>NaD*2HwVs]6XtπU"+8a3^G>QKf8sbuv7^a1C(3>44%c4Lh'a*3\4>3lnF,gi3.T5HxE&^LlKJd-(=8CπU"+BI>ipQ\dU.0/2N9#o-sX85:5v)3VlP#:Jc;]boKs:OqaWQj'RZn8ep>Ogzb+qgπU"v84*mFvgFOZ]zcs:bRM0BewvkvTd7Ay>S+Oxt?DM/h9%,UNOs0G$P-/?U4'%fe*πU"7G;gKws]+u.mN0L><Qc1$?OR2<BD$:ITG>9_U%%'e%.>xtD9][::ilDMeqwp/:HπU"et__XToHBIfe)3ZQZlb$CJPAHgy.8T7PT)QsS.^1>P*9/5PffmMmF&'qCzm/q[5πU"l(?_M3?iivEpsDXs0nO>1fZRV8f[2g[WFhvQ+T#>UwzVy*wOckNq0$QSW2KVHm-πU"YTDI3jp7-M]mel91K7n>C0M^j585*?AB:NC&k#Z6LFV#wj0%)0fbSTv(BblmHOEπU".)K;\$[NEV-At4)18jjSkE>:]*k^&AhfPceB6avR?Yr73D4cLGSAI6OW;iD+HOxπU".Bv7v-AIo];AbnfV>ZC&H8pf6Yb=FE8tLiVrLG1:wZ*JO9;;Apw^Sx.*J#Hk#COπU"<f%MnwiY)z4MHD<#.o$2Fl6.C6x5LJsdd?oEQBdg>3[9f)d:3j_iFo.d&%Nv891πU"IWlzn]2eeVB5E7E.O1.GkM15[8(#M_IdDf?5A+:yX4PV%(DC9GD8>2pdYJ??jnHπU".3epI'+$0=M_OO))yXzvI9A%#RDJ9A1yduNo\f^wT1q1ea$au>p1Ei+>s:a\NQ2πU")X_]=H'[Mg3tT-8$PKM)Q9sIV-(Pu):IBdgONYc;i6OgMbnK78&#ci)(r]-s-lgπU"'Ex*2.1;<PUI1I$SfH85nQ1rpy'SDs7('nL(I>zB-DXApYX\vC1)rrOdM$uCO;1πU"m$JQQU;aDw5y65xQeS/(OSwN7F,yKNq:2T3sI<_tw\[*I;A30OK3*4'n4FIS1UFπU"6%,HMFJ>AljSuBs/O1fE&1Rhr0[p*oW^hdwO/pExenV.)nT*Mn=eRcm1+xrM_];πU"]2J?C+*<w'*/lM(2T1j$'^1w36J]+)I_)tzvx.RZHQ'pcM5E,2O9/h)]ZLkgPJ;πU"PIZGfrsTwtdkK'.?xo5Co-7hdC=x)tn]oM)$s+BhpA_-gq7CnNH/Spa\DFdXA(.πU")&A$5<u#gCO(s=Q(.o=tx=XdEi(]Dx,Ng[>GnZHP553<S09MHkXhaP?.U;w*)#rπU"k[#/Gt,g^g#ra#HBKSRa6E2gV6nZ)]<w56q]M0\8wtB#rF+#W$=N^N8YJZa$unuπU"gnW#],iD-K^]h:\7Oa;3$9\oM<is/g<.HsC,SoRf[vTI<ksod&(M*/[1Vj1_IFjπU"(rFV&V:NOABi#g&N8W4Z2?qR&bonKkBKoi7aDlRZPB%GcCCh++^,N+tMG>?PhsZπU"'Y-m(1g3yrlG0c2hp1A$Pp-hpM]*U0cY<[Y9q\)m':s;1HUFx37[a^l)j,HYB.=πU"4L$iB]qxk4M('MUlF5MU^Ax:>:F3Ttbm0'._tU5$STpW%#nJ2?6EH?+>c'Gtd3nπU"vZWiP$c66U)[tWd^FELwsl..4$,]:?D3Z+9Y6aV,m=ZWbik_uZZ:^A?)6t-G#U>πU"RgB?b'WRy#&xyHs9uq'/LdLQrYr&-?lItL+&pwLGcF\94IAz-UA>wlS(qWEmmo(πU".UU#Cr\Qlac86CKr'KH$Lv4?94AIIl;C)_2Mce,gdGhTE<'-1VM$,ZYh-AbR>MNπU"Zh&8Fg#7DP==t;K+yq;<sCJ6W(OL?S)dU,ln(Jq9]8&^b(uSv]8vs$:+/lF%sAiπU"wOlePVa,2s\KZfXFOrGk]/kHA$^\<'9cJ<6T-(HOsF4Xw^.eu.b1ux,o'32[B$PπU"S9]kXUc[:/pHy^mV;CmIP2G,SbpwRAlWe:pBWmlbCkSS?918KD>Mhi9jzOE>x*\πU"Ybs?W7?I'k'''p&^d']wj(5V0li)F-ek2&Y5nIK&NE#y[:,kq&Jn_;UF4M:<A6jπU"<]n$pi94>]m[h[,qYFxr<)TW<<:n+x,V.K2.uc\(v0GoRet,.p+)>2Q]I=>uPdrπU"g_TX;)uQkYDI6xdG1[I?YL:;rfF7)=<m8H/fWow2q5_Mg_jRS,xQ_23[\SWJH3$πU"3-gSA0]&'S2QaUu5EA+n>02^z5ED4M<Sf3iMY3Wkpk[.78Q:x>JW6.C>W']X.myπU"uEFHot\wPVe0f%V('QjHq*AgTg:Rg\&fqY1s<^T93l44Ub.#_s>xX:7;7Bo.:8SπU"N4-fHTX->EE*8Lr+a1zzFk.kd>92NE+#&=$D<=*UH>_QX?]E>D/n>#.1MAs?#DcπU"eDRhUvi&aR*ws_(o?cWOX5eBd[6IY3XXme*Nm:mN\O5jnoE6Tn;vW_jrvFv(hxrπU"Q2SiqM+]v,G<$H_u;dwtTW^?k1FeD)0:p'4LXa%4HN[Ni$H^/o]sx^b4xmu>n];πU"w_U%eQI0oZLrU8P)g-a7k;7qBC)dmI#M+2F0FJLrlEC7J4B)lWNV=TFEP]8v&r#πU"/B7_l9b,&b_(A(<\>,Fvl;xBX1<*3?C]DAgPKmKjlRk.?dq\<b.uTGh6U>MPCrOπU"\+tv,;hB1L4>L\;k\[rlKDA2ne4)pdb?/D%FfkjZL'RJW#E,m5QD]5=REagl3;cπU"j]eH/S0=j[1M8P29n[[sKkAgjQG$k4=Y\*]3VR7E\?cb]adWDu4=&bnZc$-F8P5πU".2.^CN^+,0q&_BJG0vJfYWjr.:>u48SPYF6pTC]CIs)[:zhpbO&tiJBJnI\,v_gπU"//f_CCk_-sqEc]TQgeAp+Tf9.cs%n<1:yHkog7.wKfBRUU\<RoP(ll$],isMZQdπU"-LcFc)#<KR/jDV(<M6ZF3PmLzjDv(znzt?\_bYS+[S%Srbni?L)Nc4oobvMY\O#πU"jP>:MelKM-Dv0XVNN;sH1brEwZM1NmZJ-FIV[WfxS;p]ObXM6JIuMoEd8#IUua7πU"RC_xQ+P'MRcZ_E$DD?>)TFsNmjJFgY/$29jGk#remn?$.WUb)Hl#t6-wU/x&n=\πU"7cSA)z^c\n.^I$[Wrs?G_h>4PAh*U$R(S<8jb]oh_(a]D\IBBEk\%Q4$eTw'nM&πU"Dln?bZ2wfRtZK:j3KMDKM;,=NR\7ZPRJB'pb)Rf&KR:ush1p964uXsCD/ivU$hBπU"Es5U^^EJM&IOf8G,n$g<CqG7bu\D]wWKgTqkWoip*>=3p._-YFR\4EgIDH;4ADLπU"Y)2/8#&pu]c<v9P_+lngWZ$0YM_ygd_'Rh^OjS?uC?+*i''WwJf]Xpw[2srrMc<πU"j=O6V8b'BbpoRJZVqZR7[76s[UN&Y0K2[d?Jd)u=/QT]GvzEN9lwHSeMeG6VO*pπU"[EW%*hU\xO4]Kp&,NK*-\Z<wfg[$OSX*.+^^bUsQ#J^T2KQ?cmfRj97RkF.QN_0πU"mqZSNMI,2j\/EK$d_]Eq?mAk_ERJRv+pH+LdH$o0W6N;tH(]y#^Mgi*CSml:K1SπU"'TH_xtdn+qPBzo\^N=fWuj2Gj&nt5Qs.LlPIK7CLb9zOnAErc]Ee:+1xtSKIURsπU"D7c:.IY^R5?[22--:plu1?\Q4rNnx/EfbmVNgv;t,A#*YK'ib?A'ANaEXQPuPWTπU"<j]hjd0>_b0;ikk;wOOlNih5]0toHVu%bkwG<LToh26Qr-1eND8xjns*7fl<<wrπU"t7Zx(jN8;.?tS*t=Ovr/we((kpxc=X#7we)zNp<R06E4,Ae8Nri+XUNBue]cd#cπU"L/g;7q$07It0QKBZ(&bgI>D[;]J/GEP)Wl5V6$tTF%LdI0%hWdI]kGXd#aXD>18πU"W[xuc\iAAvQtk4?q8C?WG<tYZi/P?0lisaCWS;m$+WBc<Da51xSf+>-_Z2WD6ipπU"Y-IW%2Nvoh37jv\5)D0tEp1<d#SCXtrT*aot-mFv$b3,]nrLgIqsYFJt?oKAJ(oπU"<rfmA)3t6_NWfUzJ.two_')qzjjC\Fz*pRy/25zE9vkhF,nXzp-6SB<:Es/B]==πU"_r:nWY7wT:fAv0TaSwk%xg_$(tAlH&;oRhacGJ5NA*jkZ=^/KNb%T$I.GKc\vaLπU"$/qGYg\F?lefnaT2,zgn8+kknR/v]pY98pJe+bA9Hqc]>#*2P*xCTeK*:;$2W*+πU",&b*LEX<0YWu-;eMw9]kJ*]AZs;AjVgLdht.H[Yq:f-u<E]riPvG_4w\bx$-iTvπU"tI3V6GIb9\TpTvIM9hip^u%aP0OJ\J4BVsJuv=2BQwl_vrG(WkO6E/.=v722bisπU"u'Fy]x.T7*3qhn238-aQo0p[&XL?Rn3AIz/\uooNfO=L2smpd=<-.?L*ZPc/F/TπU"/F-P(U_de1^&?V&7J,$VLYS]k71OTBsji]lK.q<12MYyasd:1U>Ebwe1(A.=(kHπU"GgeqpgK**\,;DET;baQ4VKS0Llu8SB.J6_HrkmOl&N%b7],hqO<rX2T=Rt:3B#\πU"Ud(M+gBx3mv.ERg_iz7&1MOrx**m*#4mL<x:(2(Kq18$3XqLg?b]1/AdHobMczTπU"=ZM=kQ(aeV1mN:hg4.#p=Fv6>,w;t3(\&M_u$\ePP%Hg?oxW,E#_L:x^R6lRuHQπU"o'%r\^p\<wLoM82MXd6d<5Z2EMC$ig0D+U7FpUl8nKah(%?3:2BRc/1ylHrO]_[πU"66dr..<<MDu_L\M^hjpZ9DuN+C^8Y/iDY]3q/Ry+r_m<SdoMKq%\8$r-c^*GhKcπU"=gYeRthc7B82Smb0Xnf&$&0?M/6?rNu%p&'9%%9%%%%-%NA,qEP&VFD^[,%%<%4πU"%%,%%%%%%%%%&%%E%%%%%%%%%wfi%Sith%up&'%9%9%%%%-%)GtZEVRb_u%>(%%πU"&v4%%%,%%%%%%%%%%%E%.%%-,%%%wf%iSif%yup&%'9%9%%%%-%%XLpCE\u)*%=πU":%+%Oa%%%,%%%%%%%%%&%E#%%%k%/%%w%fiSg%fxup%*+%%%%%(%.(%n%%%%TE%πU"%%%%πEND SUBπCLOSE:IF S=231AND B&=Z&THEN?" :) Ok!"ELSE?" :( Bad!πSUB U(A$):FOR A=1TO LEN(A$):C=ASC(MID$(A$,A))-37:IF C<0THEN C=91+C*32πIF K<4THEN K=C+243ELSE?#1,CHR$(C+(K MOD 3)*86);:K=K\3:B&=B&+1πS=(S+C)AND 255:NEXT:LOCATE,1:?STRING$(B&*50\Z&,219);:END SUBπAaron Scott Zabudsky           GAME OF LIFE ALGORITHM         [e-mail]        12-27-95 (00:11)       QB, QBasic, PDS        73   5211     GOFLIFE.BAS maxwidth = 80πmaxheight = 25πDIM world(maxwidth + 1, maxheight + 1)πDIM result(maxwidth + 1, maxheight + 1)ππFOR y = 1 TO maxheightπ   FOR x = 1 TO maxwidthπ      READ world(x, y)π   NEXT xπNEXT yππa$ = ""πWHILE a$ <> "X"π   CLSπ   FOR y = 1 TO maxheightπ      FOR x = 1 TO maxwidthπ         IF world(x, y) = 1 THEN LOCATE y, x: PRINT "@";π      NEXT xπ   NEXT yπ  π   FOR y = 1 TO maxheightπ      FOR x = 1 TO maxwidthπ         count = world(x - 1, y - 1) + world(x, y - 1) + world(x + 1, y - 1)π         count = count + world(x - 1, y) + world(x + 1, y)π         count = count + world(x - 1, y + 1) + world(x, y + 1) + world(x + 1, y + 1)π         IF count = 3 THENπ            result(x, y) = 1π         ELSEIF count = 2 AND world(x, y) = 1 THENπ            result(x, y) = 1π         ELSEπ            result(x, y) = 0π         END IFπ      NEXT xπ   NEXT yπ  π   FOR y = 1 TO maxheightπ      FOR x = 1 TO maxwidthπ         world(x, y) = result(x, y)π      NEXT xπ   NEXT yπ  π  π   a$ = UCASE$(INKEY$)ππWENDπππDATA 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0πDATA 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0πDATA 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0πDATA 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0πDATA 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0πDATA 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0πDATA 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0πDATA 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0πDATA 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0πDATA 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0πDATA 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,1,1,1,1,1,1,1,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0πDATA 0,0,0,0,0,0,0,0,0,0,0,1,1,1,0,0,0,0,0,0,0,0,1,1,1,1,1,1,1,1,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0πDATA 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,1,1,1,1,1,1,1,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0πDATA 0,0,0,0,0,0,0,0,0,1,0,0,0,0,0,1,0,0,0,0,0,0,1,1,1,1,1,1,1,1,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0πDATA 0,0,0,0,0,0,0,0,0,1,0,0,0,0,0,1,0,0,0,0,0,0,1,1,1,1,1,1,1,1,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0πDATA 0,0,0,0,0,0,0,0,0,1,0,0,0,0,0,1,0,0,0,0,0,0,1,1,1,1,1,1,1,1,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0πDATA 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,1,1,1,1,1,1,1,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0πDATA 0,0,0,0,0,0,0,0,0,0,0,1,1,1,0,0,0,0,0,0,0,0,1,1,1,1,1,1,1,1,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0πDATA 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,1,1,1,1,1,1,1,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0πDATA 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,1,1,1,1,1,1,1,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0πDATA 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,1,1,1,1,1,1,1,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0πDATA 0,0,0,0,1,1,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0πDATA 0,0,0,0,0,0,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0πDATA 0,0,0,0,0,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0πDATA 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0ππAndrew Jones                   SILLY GAME                     FidoNet QUIK_BAS Echo          04-14-96 (14:33)       QB, QBasic, PDS        70   1676     ARG.BAS     'This is a silly game I wrote awhile back.  There are 20 or so big dotsπ'moving around and you are the one that is NOT their color.  All you do isπ'avoid them, each time you touch them your score is reset.  Whoop.  It'dπ'prolly be more fun on a Calculator written in Z80 asm, but oh well.ππDEFINT A-Zπdie = 0πxx = 0πyy = 0πRANDOMIZE TIMERπSCREEN 13πDIM bx(20)πDIM by(20)πDIM bmy(20)πDIM bmx(20)πd = 0πmy = 1πDOπLINE (xx, yy)-(xx + 2, yy + 2), 0, BFπl$ = INKEY$πSELECT CASE l$πCASE "4"πmx = -1πCASE "6"πmx = 1πCASE "8"πmy = -1πCASE "2"πmy = 1πEND SELECTπxx = xx + mxπyy = yy + myπIF xx > 319 THEN xx = 319πIF xx < 0 THEN xx = 0πIF yy < 0 THEN yy = 0πIF yy > 199 THEN yy = 199πLINE (xx, yy)-(xx + 2, yy + 2), 9, BFπFOR t = 0 TO 20πIF bx(t) = 0 AND by(t) = 0 THENπbx(t) = INT(RND * 320)πby(t) = INT(RND * 200)πbmx(t) = INT(RND * 5) + 2πIF INT(RND * 2) + 1 = 1 THEN bmx(t) = -bmx(t)πIF INT(RND * 2) + 1 = 1 THEN bmy(t) = 1 ELSE bmy(t) = -1πEND IFπLINE (bx(t), by(t))-(bx(t) + 2, by(t) + 2), 0, BFπbx(t) = bx(t) + bmx(t)πby(t) = by(t) + bmy(t)πIF bx(t) > 319 THEN bmx(t) = -bmx(t)πIF bx(t) < 0 THEN bmx(t) = ABS(bmx(t))πIF by(t) > 199 THEN bmy(t) = -bmy(t)πIF by(t) < 0 THEN bmy(t) = ABS(bmy(t))πIF POINT(bx(t), by(t)) = 9 THEN die = 1πIF POINT(bx(t) + 1, by(t)) = 9 THEN die = 1πIF POINT(bx(t) + 1, by(t) + 1) = 9 THEN die = 1πIF POINT(bx(t), by(t) + 1) = 9 THEN die = 1πIF die = 1 THENπscore = 0πdie = 0πx = 0πy = 0πEND IFπLINE (bx(t), by(t))-(bx(t) + 2, by(t) + 2), 2, BFπNEXTπLINE (0, 195)-(score \ 4, 199), 4, BFπLINE (319, 195)-(score \ 4, 199), 0, BFπscore = score + 1πLOOP UNTIL score = 319 * 4πCLSπENDπJustin Pasher                  LINE & CIRCLE REPLACEMENTS     FidoNet QUIK_BAS Echo          04-14-96 (21:45)       QB, QBasic, PDS        83   2120     GRAPHICS.BAS'> 'I need an algorythm (sp) that will allow me to draw a line withoutπ'> 'using the LINE command. The code below gives you an idea of whatπ'...ππ' Here's some code. I converted it from Pascal, so I hope it's allπ'correct! Enjoy!ππSUB Line (X1, Y1, X2, Y2, Col)π  ' This draws a line from X1,Y1 to X2,Y2π  XLength = ABS(X1-X2)π  DX = SGN(X1-X2)π  YLength = ABS(Y1-Y2)π  DY = SGN(Y1-Y2)π  IF DY = 0 THENπ    IF DX = -1 THENπ      FOR X = X1 TO X2π        PSET(X,Y1),Colπ      NEXTπ    ELSEIF DX = 1 THENπ      FOR X = X2 TO X1π        PSET(X,Y1),Colπ      NEXTπ    END IFπ    EXIT SUBπ  END IFπ  IF DX = 0 THENπ    IF DY = -1 THENπ      FOR Y = Y1 TO Y2π        PSET(X1,Y),Colπ      NEXTπ    ELSEIF DY = 1 THENπ      FOR Y = Y2 TO Y1π        PSET(X1,Y),Colπ      NEXTπ    END IFπ    EXIT SUBπ  END IFπ  XSlope = XLength/YLengthπ  YSlope = YLength/XLengthπ  IF YSlope/XSlope < 1 AND YSlope/XSlope > -1 THENπ    IF DX = -1 THENπ      FOR X = X1 TO X2π        Y = CINT(YSlope*X)π        PSET(X,Y),Colπ      NEXTπ    ELSEIF DX > 0 THENπ      FOR X = X2 TO X1π        Y = CINT(YSlope*X)π        PSET(X,Y),Colπ      NEXTπ  ELSEπ    IF DY < 0 THENπ      FOR Y = Y1 TO Y2π        X = CINT(XSlope*Y)π        PSET(X,Y),Colπ      NEXTπ    ELSEIF DY > 0 THENπ      FOR Y = Y2 TO Y1π        X = CINT(XSlope*Y)π        PSET(X,Y),Colπ      NEXTπ  END IFπEND SUBππ'> If that algorithm for drawing lines is in ASM could you convertπ'> it to QB and send it to me? Anything for a circle?ππ' Well what do ya know! I do have a circle algorithm! Here 'tis!π'(converted from Pascal again, so you might need a few END IFs.. :)π'NOTE: This algorithm seems to draw the circle where it looks more likeπ'an ellipse, but it's sorta close to a circle. You can try messing aroundπ'with a few aspects to tweak it out. Laterz...ππSUB Circles(X, Y, Rad, Col)π  ' This draws a circle with center X,Y, with Rad as it's radiusπ  Deg = 0π  DOπ    X = CINT(Rad*COS(Deg))π    Y = CINT(Rad*SIN(Deg))π    PSET(X+160,Y+100,Col)π    Deg = Deg + 0.005π  LOOP UNTIL Deg > 6.4πEND SUBπLarry Stone                    LIST OF DRIVES                 FidoNet QUIK_BAS Echo          01-01-90 (00:00)       QB, PDS                75   2450     DRVLIST.BAS ' > In QuickBASIC, how do I obtain a list of all active drives (exceptπ' > diskette drives).  In other words, the C drive and any Novellπ' > network drives.ππDEFINT A-Zππ'$INCLUDE: 'qbx.bi'ππDECLARE FUNCTION FDList$ ()πDECLARE FUNCTION HDList$ (FloppyList$)ππ'***********************************************************************π'* FUNCTION FDList$π'*π'* PURPOSEπ'*    PEEKs at the BIOS Equipment Word to return a list of floppyπ'*    drives installed on the system.π'*π'* CREDIT(S)π'*    Larry Stone, based on a routine published in MicroHelp's BUGπ'*    Newsletter, 1/1/90.π'*π'*    Modified to use fixed-length strings.π'***********************************************************************πFUNCTION FDList$ STATICπ   DEF SEG = 0π   FD% = PEEK(&H410) \ 64 + 1                'How many FDs installed?π   DEF SEG                                   'Restore DGROUPπ   FD$ = SPACE$(FD%)ππ   FOR N% = 1 TO FD%                         'Place these letters intoπ      MID$(FD$, N%, 1) = CHR$(64 + N%)       '  FD$π   NEXTππ   FDList$ = FD$                             'Return valueπ   FD$ = ""πEND FUNCTIONππ'***********************************************************************π'* FUNCTION HDList$π'*π'* PURPOSEπ'*    Uses DOS ISR 21H, Function 44H, Subfunction 09H (Is Drive Remote)π'*    to return a list of valid, local hard drives.π'*π'* CREDIT(S)π'*    Larry Stone, based on a routine published in MicroHelp's BUGπ'*    Newsletter, 1/1/90.π'*π'*    Modified to use fixed-length strings.π'***********************************************************************πFUNCTION HDList$ (FloppyList$)π   DIM IRegs AS RegType, ORegs AS RegTypeππ   FloppyList$ = FDList$                     'Get floppy drive listπ   FDs% = LEN(FloppyList$)                   'How many drives found?ππ   HD% = FDs% + 1 + ABS(FD% = 1)             'If only 1 FD, first is C:π   HD$ = SPACE$(HD%)ππ   FOR BL% = HD% TO 26                       'Check possible hard drivesπ      IRegs.ax = &H4409                      'Set up callπ      IRegs.bx = BL%                         'Drive letter in BLπ      Interrupt &H21, IRegs, ORegs           'Call DOSππ      IF (ORegs.flags AND 1) THEN            'Check carry flagπ         EXIT FORπ      END IFππ      MID$(HD$, HD%, 1) = CHR$(64 + ORegs.bx)'Add the letterπ   NEXTππ   HDList$ = HD$                             'Return valueπ   HD$ = ""πEND FUNCTIONπThomas Gohel                   DETECT COMPUTER PROCESSOR UNIT comp.lang.basic.misc           02-03-96 (00:00)       PB                     173  4957     PBCPU.BAS   '*************************************************************************π'π'  PBCPU.BAS:  Ermitteln des Prozessortyps in PowerBASIC 3.0/3.2π'              / CPU-Detection with PowerBASIC 3.0/3.2π'π'  entwickelt von Thomas Gohel  Fido:      2:2410/301.12π'  Version: 1.01                InterNet:  [e-mail]π'  Stand  : 02.03.1996          Homepage:  http://www.snafu.de/~pbsound/π'π'  unter Verwendung einiger Sourcen aus dem Jahre 1994 aus der ASM86.GERπ'π' --------------------------------------------------------------------------π'π' Beschreibung: Das Programm fΣngt beim Status Prozessor = 8086 an undπ' ⁿberprⁿft, ob jeweils die Statusregister-Bits des nΣchst h÷herenπ' Prozessors gesetzt werden k÷nnen.π' Bei Erkennung der Unterstⁿtzung des CPUID-Befehls wird der Prozessortypπ' aus der 'Familykennung' ermittelt. Neuere CPU's sollten diesen Befehlπ' unterstⁿtzen, ebenso zukⁿnftige Prozessorgenerationen.π'π'     Bedeutung der Variable Prozessor?:π'     0   = 8086/8088π'     1   = 80186π'     2   = 80286π'     3   = 80386π'     4   = 80486π'     5   = 80586 (Pentium)π'     6   = 80686 (Pentium Pro)π'     7   = nΣchste CPU-Generationen :-))π'     255 = V20/V30π'π'***************************************************************************ππ$COMPILE EXEπPRINT "ermittelter Prozessortyp: "; CPUTyp$πENDππFUNCTION CPUTyp$ publicπ        LOCAL Prozessor?π        DIM Vendor AS STRING * 12ππ        ! pushfπ        ! mov     ax, &h0000π        ! push    axπ        ! popfπ        ! pushfπ        ! pop     axπ        ! and     ax, &hF000π        ! cmp     ax, &hF000π        ! jnz     Teste286ππ        ! mov     ax, &hFFFFπ        ! mov     cl, &h21π        ! shl     ax, clπ        ! jnz     Setze186π        ! mov     Prozessor?, &h00π        ! popfππ        ! xor     ax, axπ        ! mov     al, &h40π        ! mul     alπ        ! jz      SetzeNECπ        ! jmp     CPUEndeππ        Setze186:π        ! mov     Prozessor?, &h01π        ! popfπ        ! jmp     CPUEndeππ        SetzeNEC:π        ! mov     Prozessor?, &hFFπ        ! jmp     CPUEndeππ        Teste286:π        ! mov     ax, &h7000π        ! push    axπ        ! popfπ        ! pushfπ        ! pop     axπ        ! and     ax, &h7000π        ! jnz     Teste386π        ! mov     Prozessor?, &h02π        ! popfπ        ! jmp     CPUEndeππ        Teste386:π        ! mov     bx, spπ        ! and     sp, &hFFFCπ        ! db      &h66π        ! pushfπ        ! db      &h66π        ! pop     axπ        ! db      &h66π        ! mov     cx, axπ        ! db      &h66π        ! xor     ax, &h0000π        ! dw      &h0004π        ! db      &h66π        ! push    axπ        ! db      &h66π        ! popfπ        ! db      &h66π        ! pushfπ        ! db      &h66π        ! pop     axπ        ! db      &h66π        ! xor     ax, cxπ        ! mov     Prozessor?, &h03π        ! mov     sp, bxπ        ! jz      CPUEndeπ        ! and     sp, &hFFFCπ        ! db      &h66π        ! push    cxπ        ! db      &h66π        ! popfπ        ! mov     sp, bxππ        Teste486:π        ! mov     Prozessor?, &h04π        ! db      &h66π        ! mov     ax, cxπ        ! db      &h66π        ! xor     ax, &h0000π        ! dw      &h0020π        ! db      &h66π        ! push    axπ        ! db      &h66π        ! popfπ        ! db      &h66π        ! pushfπ        ! db      &h66π        ! pop     axπ        ! db      &h66π        ! xor     ax, cxπ        ! je      CPUEndeππ        TesteCPUID:π        ! db      &h66π        ! xor     ax, axπ        ! inc     axπ        ! dw      &hA20Fπ        ! and     ah, &h0Fπ        ! mov     Prozessor?, ahπ        ! xor     ax, axπ        ! dw      &hA20Fπ        ! db      &h66π        ! mov     Vendor$[00], bxπ        ! db      &h66π        ! mov     Vendor$[04], dxπ        ! db      &h66π        ! mov     Vendor$[08], cxππ        CPUEnde:π        SELECT CASE Vendor$π            CASE "GenuineIntel": Manufacturer$ = "Intel "π            CASE "AuthenticAMD": Manufacturer$ = "AMD "π            CASE "NexGenDevice": Manufacturer$ = "NexGen "π            'CASE "UMC UMC UMC ": Manufacturer$ = "??? "π            CASE ELSE          : Manufacturer$ = "Intel "π        END SELECTπ        SELECT CASE Prozessor?π            CASE 0  : CPUTyp$ = "Intel 8088/8086"π            CASE 1  : CPUTyp$ = "Intel 80186"π            CASE 2  : CPUTyp$ = "Intel 80286"π            CASE 3  : CPUTyp$ = "Intel 80386"π            CASE 4  : CPUTyp$ = Manufacturer$ + "80486"π            CASE 5  : CPUTyp$ = Manufacturer$ + "Pentium"π            CASE 6  : CPUTyp$ = Manufacturer$ + "Pentium Pro"π            CASE 255: CPUTyp$ = "NEC V20/V30"π            CASE ELSE:π                      CPUTyp$ = "Intel 80" + CHR$(Prozessor? + 48) + "86"π        END SELECTπEND FUNCTIONπJim Emptage                    PATH CHECK                     [e-mail]      03-10-96 (01:47)       QB, QBasic, PDS        190  4725     PATHCHK.BAS 'PATHCHK BY ROUGE VALLEY SOFTWARE 1996 [e-mail]π'π'* Place program anywhere on the C: driveπ'* It will show your path, and check that all directories existπ'* If some directories are no longer valid you will be asked if youπ'* wish the PATH line in your autoexec.bat file changed to remove themπ'* A back up of your original autoexec.bat file is [made autoexec.rvs]π'* Shareware, all rights reservedπ'* Please ask permission if distributed in any package that is for sale.π'π'Jim Emptage, Rouge Valley SoftwareπCLSπCOLOR 7, 4πPRINT " ROUGE VALLEY SOFTWARE PATH CHECK (1996)   [e-mail]            "πCOLOR 7, 0πOPEN "rvsdrive.dat" FOR OUTPUT AS #2πCLOSE #2πSHELL "cd>rvsdrive.dat"πOPEN "rvsdrive.dat" FOR INPUT AS #2πDO UNTIL EOF(2)π  INPUT #2, CURDRIVE$πLOOPπCLOSE #2πPRINT "EXAMINE PATH STATEMENT : Changing to the root drive \"πPRINT "                       : Return to : "; CURDRIVE$; " when done."πCHDIR "\"πCOLOR 7, 1πPRINT " MAKING DOS VERIFIED BACKUP OF AUTOEXEC.BAT > AUTOEXEC.RVS                      "πCOLOR 7, 0πSHELL "COPY AUTOEXEC.BAT C:\AUTOEXEC.RVS/V/Y"πOPEN "rvstemp.dat" FOR OUTPUT AS #1πCLOSE #1πOPEN "rvstemp.dat" FOR APPEND AS #1πOPEN "autoexec.bat" FOR INPUT AS #2πcnt = 0πDO UNTIL EOF(2)π  LINE INPUT #2, x$π  cnt = cnt + 1π  IF UCASE$(MID$(x$, 1, 4)) = "PATH" THENπ    EXIT DOπ  END IFπLOOPπCLOSE #2πCOLOR 7, 4πPRINT " CURRENT PATH: ";πCOLOR 7, 0πPRINT RTRIM$(x$)πPRINT "Line in AUTOEXEC.BAT: "; cnt;πPL = LEN(x$)πPRINT " PATH length: "; PLπPRINT "[ Note PATH line can only have 127 characters ]"πCOLOR 7, 1πPRINT " COUNTING DIRECTORIES IN PATH:                                                  "πCOLOR 7, 0πx$ = UCASE$(x$)πpcnt = 0πFIRST = INSTR(x$, "C:\")πFOR M = FIRST TO PLπ  P$ = MID$(x$, M, 1)π  IF P$ <> ";" THENπ    PDIR$ = PDIR$ + P$π  ELSEπ    IF RTRIM$(PDIR$) <> "" THENπ      PRINT " "; PDIR$; " ";π      PRINT #1, PDIR$π      PDIR$ = ""π      pcnt = pcnt + 1π    END IFπ  END IFπNEXTπIF RTRIM$(PDIR$) <> "" THENπ  PRINT " "; PDIR$; " ";π  PRINT #1, PDIR$π  PDIR$ = ""π  pcnt = pcnt + 1πEND IFπPRINTπPRINT pcnt; " DIRECTORIES IN PATH "πCLOSEπCOLOR 7, 4πPRINT " CHECKING THAT ALL DIRECTORIES ARE VALID                                        "πCOLOR 7, 0πREDIM iv(pcnt) AS STRINGπON ERROR GOTO DERRπOPEN "RVSTEMP.DAT" FOR INPUT AS #1πIVCNT = 0πDO UNTIL EOF(1)π  INPUT #1, dc$π  dc$ = RTRIM$(dc$)π  IF MID$(dc$, LEN(dc$), 1) = "\" THENπ    dc$ = MID$(dc$, 1, LEN(dc$) - 1)π  END IFπ  CHDIR dc$π99π  IF ed = 1 AND block = 0 THENπ    COLOR 14, 4π    PRINT " INVALID DIRECTORIES FOUND ... [THEY DO NOT EXIST]                              "π    COLOR 7, 0π    block = 1π  END IFπ  IF ed = 1 THENπ    PRINT " "; dc$; " ";π    IVCNT = IVCNT + 1π    iv(IVCNT) = dc$π    ed = 0π  END IFπLOOPπCLOSEπCHDIR "\"πIF block = 0 THENπ  COLOR 1, 7π  PRINT " NO INVALID DIRECTORIES FOUND ... ALL DIRECTORIES LISTED EXIST ... PASS         "π  COLOR 7, 0πEND IFπIF IVCNT = 0 THEN GOTO 101πCOLOR 7, 1πPRINTπPRINT " REMOVE INVALID DIRECTORIES FROM PATH (Y/N)                                     "πCOLOR 7, 0π88πWHILE INKEY$ <> ""πWENDπCH$ = UCASE$(INPUT$(1))πSELECT CASE CH$π  CASE "Y"π    OPEN "rvstemp.dat" FOR INPUT AS #1π    np$ = "PATH "π    DO UNTIL EOF(1)π      LINE INPUT #1, x$π      nogo = 0π      FOR z = 1 TO IVCNTπ        IF INSTR(UCASE$(x$), iv(z)) > 0 THEN nogo = 1π      NEXTπ      IF nogo = 0 THENπ        np$ = np$ + UCASE$(x$) + ";"π      END IFπ    LOOPπ    CLOSEπ    COLOR 7, 1π    PRINT " UPDATING PATH IN AUTOEXEC.BAT TO:                                  "π    COLOR 7, 0π    PRINT np$π    OPEN "rvstemp2.dat" FOR OUTPUT AS #1π    OPEN "autoexec.bat" FOR INPUT AS #2π    pblock = 0π    DO UNTIL EOF(2)π      LINE INPUT #2, x$π      IF UCASE$(MID$(x$, 1, 4)) = "PATH" AND pblock = 0 THENπ        pblock = 1π        PRINT #1, np$π      ELSEπ        PRINT #1, x$π      END IFπ    LOOPπ    CLOSEπ    KILL "AUTOEXEC.BAT"π    NAME "RVSTEMP2.DAT" AS "AUTOEXEC.BAT"π  CASE "N"π  CASE ELSEπ    SOUND 40, 1π    GOTO 88πEND SELECTπ101πCLOSEπKILL "\rvstemp.dat"πCHDIR CURDRIVE$πLOCATE 25, 1πCOLOR 14, 1πPRINT " FINISHED    -    PRESS ANY KEY TO EXIT PROGRAM                                 ";πCOLOR 7, 0πWHILE INKEY$ <> ""πWENDπDOπLOOP WHILE INKEY$ = ""πCLSπENDπDERR:πIF ed = 0 THEN ed = 1πSELECT CASE ERRπ  CASE 76π    SOUND 40, 1π    RESUME 99π  CASE ELSEπ    PRINT ERR, ERLπ    PRINT "WARNING: UNDETERMINED ERROR"π    PRINTπ    PRINT "DO NOT USE THE INFORMATION PROVIDED BY THIS PROGRAM"π    PRINT "CHECK YOUR AUTOEXEC.BAT FILE INCASE OF UNWANTED CHANGES"πEND SELECTπRESUME 101πRobert Fortune                 DETECT IF SHARE IS LOADED      FidoNet QUIK_BAS Echo          04-11-96 (17:59)       QB, PDS                35   1811     SHARED.BAS  '>2. Is there anyone who has experience writing multi-node doors?  Now,π'>here I am referring both to the ability for the game to be playingπ'>simultaneously on multiple nodes (which DFrame does automatically), andπ'>ALSO to the ability for users on multiple nodes to be playing againstπ'>each other.ππ'   I have experience writing BBS game doors that can be play simultaneouslyπ'   on multiple nodes but they cannot play each other. I don't imagine itπ'   would be very difficult to write a door that allows players to playπ'   against each other while on different BBS nodes. I believe some peopleπ'   write player's commands\incoming data to a file which the other nodesπ'   can than read and act upon in real time. Does that help?π'     To determine if the BBS is multinode you can use the followingπ'   function to determine if DOS's TSR program SHARE is loaded and if itπ'   is then your program will know that it has to lock and unlock itsπ'   data file(s). Some people just lock all their door's data files noπ'   matter if the host BBS is multinode or not. That is up to you.ππDEFINT A-Z   ' untyped variables default to type integerπ' $INCLUDE: 'QB.BI'πDECLARE FUNCTION IsShare% ()πDIM SHARED InReg AS RegType, OutReg AS RegTypeπPRINT "The DOS Utility SHARE is ";πIF IsShare% THENπ   PRINT "loaded. Lock/Unlock your file(s) as needed."πELSEπ   PRINT "is NOT loaded. No need to lock your file(s)."πEND IFπFUNCTION IsShare% STATICπ  IsShare% = -1                           ' assume Share is loadedπ  RegType.ax = &H1000                     ' service 10hπ  CALL Interrupt(&H2F, InReg, OutReg)     ' check for presence of SHAREπ  AL = RegType.ax AND 255                 ' isolate the result in ALπ  IF AL <> &HFF THEN IsShare% = 0         ' SHARE not foundπEND FUNCTIONπGeoffrey Liu                   ERRORLEVEL OF RETURNED SHELL   QBTIPS_?.DOC                   12-17-92 (21:25)       QB, QBasic, PDS        18   706      ERRLEVEL.BAS'> I have looked in several books for the QuickBasic equivalent of Batchπ'>language's ERRORLEVEL command.  I couldn't get ERRORLEVEL to work in QBπ'>and I am wondering if there is a command that does the same thing. I'mπ'> trying to get QuickBasic to take Errorlevels from a program that I amπ'> SHELLing out to run.ππDECLARE FUNCTION ErrorLevel% () 'Returns errorlevel of shelled programππFUNCTION ErrorLevel%ππ   'Purpose : To check the error level of a program returning from shellπ   'Input   : none (well, helps if you did shell a program first)π   'Return  : The errorlevel returned from the last shelled programππ   DEF SEG = 0π   ErrorLevel% = PEEK(&H4FE)π   DEF SEGπEND FUNCTIONπJoey Shaw                      EXITING WITH ERRORLEVEL        Load with QB /LQB              08-04-92 (16:13)       QB, PDS                13   346      EXITERR.BAS '> Sure is! It's REAL simple. All you have to do is declare a sub...ππ'Ohhh...ππ'> DECLARE SUB ExitWithErrLvl ALIAS "_Exit" (BYVAL ErrorLevel%)ππ'Ok....ππ'> There thats it. Now to exit with an errorlevel just do this.π'> ExitWithErrLvl 5π'> That exits with errorlevel 5! See, pretty easy huh! See ya!ππ'Yeah, tell me about it! ThanxπTony Elliott                   CHECK IF IN A SHELL            QB TidBits                     09-06-92 (18:09)       QB, PDS                107  2993     INSHELL.BAS ' >Is it possible for a spawned program (via SHELL or more importantly viaπ' >QBSWAP) to know the name of the program which spawned it? (or even to knowπ' >that it is a shelled program and not a "top-level" program?)  How?ππ'There is a way to determine if a program is a child process. However,π'I haven't been able to determine the name of the parent process. Thisπ'EXE filename is normally store just above the apps copy of theπ'environment. Apparently this info is destroyed when the parent appπ'shells.ππ'Here's some code to determine if the app is being executed from aπ'shell:ππ'$INCLUDE: 'QB.BI'ππDEFINT A-ZπDECLARE FUNCTION ImInAShell% ()πDECLARE FUNCTION BPeek% (Segment&, Offset%)πDECLARE FUNCTION WPeek% (Segment&, Offset%)πDECLARE FUNCTION ExeName$ (Psp%)ππIF ImInAShell% THENπ    PRINT "I'm in a shell!"πELSEπ    PRINT "I'm not in a shell."πEND IFπ ππFUNCTION BPeek% (Segment&, Offset%)ππ    'Peeks a byte (two bytes) and returns it as a result of the functionππ    DEF SEG = Segment&                  'Point to data segmentπ    Temp% = PEEK(Offset%)               'Peek byte into temp variableπ    DEF SEG                             'Point back to DGroupπ    BPeek% = Temp%                      'Return itππEND FUNCTIONππFUNCTION ImInAShell%ππ  DIM Reg AS RegTypeXπ    π  IntNo = &H21                        'Get Current PSPπ  Reg.ax = &H5100π  GOSUB DoDosCallπ  CurrentPSP = Reg.bxππ  Reg.ax = &H5200                     'Get DOS "List of Lists"π  GOSUB DoDosCallπ  Offset = Reg.bxπ    π  'Get pointer to first memory control block (MCB) ES:BX-2π  MemBlock& = WPeek(CLNG(Reg.es), Offset - 2)ππ  DOπ    Id = BPeek(MemBlock&, 0)π    SELECT CASE Idπ      CASE &H4D                   'Part of MCB chainπ        OwnerPSP = WPeek(MemBlock&, 1)π        BlockSize& = WPeek(MemBlock&, 3)π        IF OwnerPSP <> 0 AND OwnerPSP <> 8 AND LastPSP <> OwnerPSP THENπ          'Valid blockπ          LastPSP = OwnerPSPπ          ParentPSP = WPeek(CLNG(OwnerPSP), &H16)π          IF ParentPSP = OwnerPSP THENπ            IF FirstCommandCom = 0 THENπ               FirstCommandCom = ParentPSPπ            ELSEπ               ImInAShell = -1π               EXIT DOπ            END IFπ          END IFπ        ELSEIF OwnerPSP = CurrentPSP THENπ          EXIT DO                         'Stop when we get to ourπ        END IF                             'own PSP.π                 π    CASE &H5A                               'Last block in chainπ        EXIT DOππ    CASE ELSE                               'Error - MCB's Destroyed!!π        EXIT DOππ    END SELECTπ    MemBlock& = MemBlock& + BlockSize& + 1      'Next block in chainπ LOOPπ EXIT FUNCTIONππDoDosCall:π    CALL INTERRUPTX(IntNo, Reg, Reg)πRETURNπEND FUNCTIONππFUNCTION WPeek% (Segment&, Offset%)ππ    'Peeks a word (two bytes) and returns it as a result of the functionππ    DEF SEG = Segment&π    TempL% = PEEK(Offset%)π    TempH% = PEEK(Offset% + 1)π    DEF SEGπ    POKE VARPTR(Result%), TempL%π    POKE VARPTR(Result%) + 1, TempH%π    WPeek% = Result%ππEND FUNCTIONππSean Smith                     ROTATING DNA ANALYSIS          FidoNet QUIK_BAS Echo          03-10-96 (09:59)       QB, QBasic, PDS        338  9160     DNA.BAS     '        Here's some cool code I found.  Does a dna string analysis.π'Definately something new!  Its on 4 different messages starting now.  Iπ'did not write this code though.  :(ππSCREEN 12ππCLSπmolcol = 15πbarcol = 8πscancol = 4πcenter = 75πinterval = .1πlength = 75πradius = 4πky = 275πjy = 250πiy = 225πhy = 200πgy = 175πfy = 150πey = 125πdy = 100πcy = 75πby = 50πy = 25πobs = 200πREM hscandir = 1πREM vscandir = 1ππLINE (0, 0)-(151, 301), 8, BπLINE (1, 1)-(150, 300), 7, BπLINE (2, 2)-(149, 299), 15, BπLINE (3, 3)-(148, 298), 7, BπLINE (4, 4)-(147, 297), 8, BππLOCATE 20, 1πCOLOR 8πPRINT "   [";πCOLOR 15πPRINT "DNA Analysis";πCOLOR 8πPRINT "]"πCOLOR 15πPRINT : COLOR 8: PRINT " ═"; : COLOR 7: PRINT "═";πCOLOR 15: PRINT "[ Building structure  ]";πCOLOR 7: PRINT "═"; : COLOR 8: PRINT "═"πmessage = 2πGOTO 20π5 FOR angle = 0 TO 36000 STEP intervalππREM -------SCAN--------ππ10πIF scanned = 1 THEN GOTO 20πIF message = 2 THEN LOCATE 22, 5: COLOR 15: PRINT " Scaning DNA String  "πIF hscan < 15 THEN hscandir = 1πIF hscan > 290 THEN hscandir = 0πIF hscandir = 0 THEN hscan = hscan - 5: LINE (5, hscan + 5)-(145, hscan + 5), 0πIF hscandir = 1 THEN hscan = hscan + 5: LINE (5, hscan - 5)-(145, hscan - 5), 0πLINE (5, hscan)-(145, hscan), scancolππIF vscan < 15 THEN vscandir = 1: pass = pass + .5πIF vscan > 140 THEN vscandir = 0:πIF vscandir = 0 THEN vscan = vscan - 5: LINE (vscan + 5, 5)-(vscan + 5, 295), 0πIF vscandir = 1 THEN vscan = vscan + 5: LINE (vscan - 5, 5)-(vscan - 5, 295), 0πLINE (vscan, 5)-(vscan, 295), scancolππIF pass = 3 THEN scanned = 1: message = 3: LINE (5, hscan)-(145, hscan), 0:πLINE (vscan, 5)-(vscan, 295), 0: FOR delay = 1 TO 5000: NEXT delay: GOTO 5πGOTO 20πIF scanned = 0 THEN GOTO 10πREM --------1------------π20π IF message = 3 THEN LOCATE 22, 5: COLOR 15: PRINT " Testing Integrity "π zangle = angle + 1π x1 = (center - (COS(zangle) * (length / 2)))π x2 = (center + (COS(zangle) * (length / 2)))π a1 = obs - (SIN(zangle) * (length))π a2 = obs + (SIN(zangle) * (length))ππ radiusx1 = (obs / a1) * radiusπ radiusx2 = (obs / a2) * radiusπ LINE (lastx1, y)-(lastx2, y), 0π CIRCLE (lastx1, y), lastrx1, 0π CIRCLE (lastx2, y), lastrx2, 0π LINE (x1, y)-(x2, y), barcolπ CIRCLE (x1, y), radiusx1, molcolπ CIRCLE (x2, y), radiusx2, molcolππ lastx1 = x1π lastx2 = x2π lastrx1 = radiusx1π lastrx2 = radiusx2πIF STAT = 0 THEN FOR delay = 1 TO 500: NEXT delayπREM-----------2-------------π bangle = angle + 1.5π bx1 = (center - (COS(bangle) * (length / 2)))π bx2 = (center + (COS(bangle) * (length / 2)))π ba1 = obs - (SIN(bangle) * (length))π ba2 = obs + (SIN(bangle) * (length))ππ bradiusx1 = (obs / ba1) * radiusπ bradiusx2 = (obs / ba2) * radiusπ LINE (blastx1, by)-(blastx2, by), 0π CIRCLE (blastx1, by), blastrx1, 0π CIRCLE (blastx2, by), blastrx2, 0ππ LINE (bx1, by)-(bx2, by), barcolπ CIRCLE (bx1, by), bradiusx1, molcolπ CIRCLE (bx2, by), bradiusx2, molcolππ blastx1 = bx1π blastx2 = bx2π blastrx1 = bradiusx1π blastrx2 = bradiusx2ππIF STAT = 0 THEN FOR delay = 1 TO 500: NEXT delayππREM-----------3-------------π cangle = angle + 2π cx1 = (center - (COS(cangle) * (length / 2)))π cx2 = (center + (COS(cangle) * (length / 2)))π ca1 = obs - (SIN(cangle) * (length))π ca2 = obs + (SIN(cangle) * (length))ππ cradiusx1 = (obs / ca1) * radiusπ cradiusx2 = (obs / ca2) * radiusπ LINE (clastx1, cy)-(clastx2, cy), 0π CIRCLE (clastx1, cy), clastrx1, 0π CIRCLE (clastx2, cy), clastrx2, 0ππ LINE (cx1, cy)-(cx2, cy), barcolπ CIRCLE (cx1, cy), cradiusx1, molcolπ CIRCLE (cx2, cy), cradiusx2, molcolππ clastx1 = cx1π clastx2 = cx2π clastrx1 = cradiusx1π clastrx2 = cradiusx2ππIF STAT = 0 THEN FOR delay = 1 TO 500: NEXT delayππREM-----------4-------------π dangle = angle + 2.5π dx1 = (center - (COS(dangle) * (length / 2)))π dx2 = (center + (COS(dangle) * (length / 2)))π da1 = obs - (SIN(dangle) * (length))π da2 = obs + (SIN(dangle) * (length))ππ dradiusx1 = (obs / da1) * radiusπ dradiusx2 = (obs / da2) * radiusπ LINE (dlastx1, dy)-(dlastx2, dy), 0π CIRCLE (dlastx1, dy), dlastrx1, 0π CIRCLE (dlastx2, dy), dlastrx2, 0ππ LINE (dx1, dy)-(dx2, dy), barcolπ CIRCLE (dx1, dy), dradiusx1, molcolπ CIRCLE (dx2, dy), dradiusx2, molcolππ dlastx1 = dx1π dlastx2 = dx2π dlastrx1 = dradiusx1π dlastrx2 = dradiusx2ππIF STAT = 0 THEN FOR delay = 1 TO 500: NEXT delayππREM-----------5-------------π eangle = angle + 3!π ex1 = (center - (COS(eangle) * (length / 2)))π ex2 = (center + (COS(eangle) * (length / 2)))π ea1 = obs - (SIN(eangle) * (length))π ea2 = obs + (SIN(eangle) * (length))ππ eradiusx1 = (obs / ea1) * radiusπ eradiusx2 = (obs / ea2) * radiusπ LINE (elastx1, ey)-(elastx2, ey), 0π CIRCLE (elastx1, ey), elastrx1, 0π CIRCLE (elastx2, ey), elastrx2, 0ππ LINE (ex1, ey)-(ex2, ey), barcolπ CIRCLE (ex1, ey), eradiusx1, molcolπ CIRCLE (ex2, ey), eradiusx2, molcolππ elastx1 = ex1π elastx2 = ex2π elastrx1 = eradiusx1π elastrx2 = eradiusx2ππIF STAT = 0 THEN FOR delay = 1 TO 500: NEXT delayππREM-----------6-------------π fangle = angle + 3.5π fx1 = (center - (COS(fangle) * (length / 2)))π fx2 = (center + (COS(fangle) * (length / 2)))π fa1 = obs - (SIN(fangle) * (length))π fa2 = obs + (SIN(fangle) * (length))ππ fradiusx1 = (obs / fa1) * radiusπ fradiusx2 = (obs / fa2) * radiusπ LINE (flastx1, fy)-(flastx2, fy), 0π CIRCLE (flastx1, fy), flastrx1, 0π CIRCLE (flastx2, fy), flastrx2, 0ππ LINE (fx1, fy)-(fx2, fy), barcolπ CIRCLE (fx1, fy), fradiusx1, molcolπ CIRCLE (fx2, fy), fradiusx2, molcolππ flastx1 = fx1π flastx2 = fx2π flastrx1 = fradiusx1π flastrx2 = fradiusx2ππIF STAT = 0 THEN FOR delay = 1 TO 500: NEXT delayππREM-----------7-------------π gangle = angle + 4π gx1 = (center - (COS(gangle) * (length / 2)))π gx2 = (center + (COS(gangle) * (length / 2)))π ga1 = obs - (SIN(gangle) * (length))π ga2 = obs + (SIN(gangle) * (length))ππ gradiusx1 = (obs / ga1) * radiusπ gradiusx2 = (obs / ga2) * radiusπ LINE (glastx1, gy)-(glastx2, gy), 0π CIRCLE (glastx1, gy), glastrx1, 0π CIRCLE (glastx2, gy), glastrx2, 0ππ LINE (gx1, gy)-(gx2, gy), barcolπ CIRCLE (gx1, gy), gradiusx1, molcolπ CIRCLE (gx2, gy), gradiusx2, molcolππ glastx1 = gx1π glastx2 = gx2π glastrx1 = gradiusx1π glastrx2 = gradiusx2ππIF STAT = 0 THEN FOR delay = 1 TO 500: NEXT delayππREM-----------8-------------π hangle = angle + 4.5π hx1 = (center - (COS(hangle) * (length / 2)))π hx2 = (center + (COS(hangle) * (length / 2)))π ha1 = obs - (SIN(hangle) * (length))π ha2 = obs + (SIN(hangle) * (length))ππ hradiusx1 = (obs / ha1) * radiusπ hradiusx2 = (obs / ha2) * radiusπ LINE (hlastx1, hy)-(hlastx2, hy), 0π CIRCLE (hlastx1, hy), hlastrx1, 0π CIRCLE (hlastx2, hy), hlastrx2, 0ππ LINE (hx1, hy)-(hx2, hy), barcolπ CIRCLE (hx1, hy), hradiusx1, molcolπ CIRCLE (hx2, hy), hradiusx2, molcolππ hlastx1 = hx1π hlastx2 = hx2π hlastrx1 = hradiusx1π hlastrx2 = hradiusx2ππIF STAT = 0 THEN FOR delay = 1 TO 500: NEXT delayππREM-----------9-------------π iangle = angle + 5π ix1 = (center - (COS(iangle) * (length / 2)))π ix2 = (center + (COS(iangle) * (length / 2)))π ia1 = obs - (SIN(iangle) * (length))π ia2 = obs + (SIN(iangle) * (length))ππ iradiusx1 = (obs / ia1) * radiusπ iradiusx2 = (obs / ia2) * radiusπ LINE (ilastx1, iy)-(ilastx2, iy), 0π CIRCLE (ilastx1, iy), ilastrx1, 0π CIRCLE (ilastx2, iy), ilastrx2, 0ππ LINE (ix1, iy)-(ix2, iy), barcolπ CIRCLE (ix1, iy), iradiusx1, molcolπ CIRCLE (ix2, iy), iradiusx2, molcolππ ilastx1 = ix1π ilastx2 = ix2π ilastrx1 = iradiusx1π ilastrx2 = iradiusx2ππIF STAT = 0 THEN FOR delay = 1 TO 500: NEXT delayππREM-----------10-------------π jangle = angle + 5.5π jx1 = (center - (COS(jangle) * (length / 2)))π jx2 = (center + (COS(jangle) * (length / 2)))π ja1 = obs - (SIN(jangle) * (length))π ja2 = obs + (SIN(jangle) * (length))ππ jradiusx1 = (obs / ja1) * radiusπ jradiusx2 = (obs / ja2) * radiusπ LINE (jlastx1, jy)-(jlastx2, jy), 0π CIRCLE (jlastx1, jy), jlastrx1, 0π CIRCLE (jlastx2, jy), jlastrx2, 0ππ LINE (jx1, jy)-(jx2, jy), barcolπ CIRCLE (jx1, jy), jradiusx1, molcolπ CIRCLE (jx2, jy), jradiusx2, molcolππ jlastx1 = jx1π jlastx2 = jx2π jlastrx1 = jradiusx1π jlastrx2 = jradiusx2ππIF STAT = 0 THEN FOR delay = 1 TO 500: NEXT delayππREM-----------11------------π kangle = angle + 6π kx1 = (center - (COS(kangle) * (length / 2)))π kx2 = (center + (COS(kangle) * (length / 2)))π ka1 = obs - (SIN(kangle) * (length))π ka2 = obs + (SIN(kangle) * (length))ππ kradiusx1 = (obs / ka1) * radiusπ kradiusx2 = (obs / ka2) * radiusπ LINE (klastx1, ky)-(klastx2, ky), 0π CIRCLE (klastx1, ky), klastrx1, 0π CIRCLE (klastx2, ky), klastrx2, 0ππ LINE (kx1, ky)-(kx2, ky), barcolπ CIRCLE (kx1, ky), kradiusx1, molcolπ CIRCLE (kx2, ky), kradiusx2, molcolππ klastx1 = kx1π klastx2 = kx2π klastrx1 = kradiusx1π klastrx2 = kradiusx2ππIF STAT = 0 THEN STAT = 1: GOTO 10πIF scanned = 0 THEN GOTO 10πIF INKEY$ <> "" THEN LOCATE 22, 5: PRINT " Analysis Aborted ": ENDπinterval = interval + .01πNEXT angleππDavid J. Arigan                BLOCK FILL                     FidoNet QUIK_BAS Echo          03-10-96 (20:22)       QB, QBasic, PDS        140  4232     BLOKFILL.BAS'Hmmm... I went back and examined my source.  I tried it with a few moreπ'shapes and managed to crash it.  It is also a little slow.  So I went backπ'and rewrote it with an entirely new algorithm that I developed.  I wasπ'kind of surprised to find as to how fast it filled in areas.  Dependingπ'on how complex the shape is, it can be a bit of a memory hog.  It uses bothπ'a stack and recursion to prevent stack and memory errors (which would haveπ'happened in a worse case scenario).  It may seem to pause on large fillπ'areas but don't worry... just give it a sec.  Well here it is:π'π' BLOKFILL.BASπ' Developed and written by David J. Ariganπ' Copyright (C)1996 - not to be used in any commercial product withoutπ' written consent from the author.πDEFINT A-ZππSCREEN 9ππ'LINE (100, 100)-(200, 150), 4π'LINE (100, 100)-(300, 100), 4π'LINE (300, 100)-(300, 150), 4π'LINE (300, 150)-(200, 150), 4π'fill 112, 102, 7, 4ππFOR i = 0 TO 310 STEP 6π  CIRCLE (320, 175), i, 4, 0, 6         ' very complex shapeπNEXTπfill 639, 0, 7, 4ππSUB fill (xp, yp, fc, bc)π  DIM xs(1500), ys(1500)π  xs(0) = xp: ys(0) = yp: stk = 1π  WHILE stk > 0π    stk = stk - 1π    x1 = xs(stk): fx1 = 0: y1 = ys(stk): fy1 = 0π    x2 = xs(stk): fx2 = 0: y2 = ys(stk): fy2 = 0π    WHILE (fx1 + fy1 + fx2 + fy2) <> 4π      IF fx1 = 0 THENπ        IF x1 = 0 THENπ          fx1 = 1π        ELSEπ          x1 = x1 - 1π          FOR i = y1 TO y2π            nc = POINT(x1, i)π            IF nc = fc OR nc = bc THEN fx1 = 1: x1 = x1 + 1: EXIT FORπ          NEXTπ        END IFπ      END IFπ      IF fx2 = 0 THENπ        IF x2 = 639 THENπ          fx2 = 1π        ELSEπ          x2 = x2 + 1π          FOR i = y1 TO y2π            nc = POINT(x2, i)π            IF nc = fc OR nc = bc THEN fx2 = 1: x2 = x2 - 1: EXIT FORπ          NEXTπ        END IFπ      END IFπ      IF fy1 = 0 THENπ        IF y1 = 0 THENπ          fy1 = 1π        ELSEπ          y1 = y1 - 1π          FOR i = x1 TO x2π            nc = POINT(i, y1)π            IF nc = fc OR nc = bc THEN fy1 = 1: y1 = y1 + 1: EXIT FORπ          NEXTπ        END IFπ      END IFπ      IF fy2 = 0 THENπ        IF y2 = 349 THENπ          fy2 = 1π        ELSEπ          y2 = y2 + 1π          FOR i = x1 TO x2π            nc = POINT(i, y2)π            IF nc = fc OR nc = bc THEN fy2 = 1: y2 = y2 - 1: EXIT FORπ          NEXTπ        END IFπ      END IFπ    WENDπ    LINE (x1, y1)-(x2, y2), fc, BFπ    m1 = -1: m2 = -1π    FOR i = x1 TO x2π      WHILE stk >= 1499π        fill xs(stk - 1), ys(stk - 1), fc, bc: stk = stk - 1π      WENDπ      IF y1 > 0 THENπ        nc = POINT(i, y1 - 1)π        IF nc <> bc AND nc <> fc THENπ          IF m1 = -1 THEN m1 = iπ          nc = POINT(i + 1, y1 - 1)π          IF i = x2 OR nc = bc OR nc = fc THENπ            xs(stk) = (i - m1) \ 2 + m1: ys(stk) = y1 - 1: stk = stk + 1π            m1 = -1π          END IFπ        END IFπ      END IFπ      IF y2 < 349 THENπ        nc = POINT(i, y2 + 1)π        IF nc <> bc AND nc <> fc THENπ          IF m2 = -1 THEN m2 = iπ          nc = POINT(i + 1, y2 + 1)π          IF i = x2 OR nc = bc OR nc = fc THENπ            xs(stk) = (i - m2) \ 2 + m2: ys(stk) = y2 + 1: stk = stk + 1π            m2 = -1π          END IFπ        END IFπ      END IFπ    NEXT iπ    m1 = -1: m2 = -1π    FOR i = y1 TO y2π      WHILE stk >= 1499π        fill xs(stk - 1), ys(stk - 1), fc, bc: stk = stk - 1π      WENDπ      IF x1 > 0 THENπ        nc = POINT(x1 - 1, i)π        IF nc <> bc AND nc <> fc THENπ          IF m1 = -1 THEN m1 = iπ          nc = POINT(x1 - 1, i + 1)π          IF i = y2 OR nc = bc OR nc = fc THENπ            xs(stk) = x1 - 1: ys(stk) = (i - m1) \ 2 + m1: stk = stk + 1π            m1 = -1π          END IFπ        END IFπ      END IFπ      IF x2 < 639 THENπ        nc = POINT(x2 + 1, i)π        IF nc <> bc AND nc <> fc THENπ          IF m2 = -1 THEN m2 = iπ          nc = POINT(x2 + 1, i + 1)π          IF i = y2 OR nc = bc OR nc = fc THENπ            xs(stk) = x2 + 1: ys(stk) = (i - m2) \ 2 + m2: stk = stk + 1π            m2 = -1π          END IFπ        END IFπ      END IFπ    NEXT iπ  WENDπEND SUBπRich Gordley                   ANOTHER PAINT REPLACEMENT      FidoNet QUIK_BAS Echo          03-09-96 (09:28)       QB, QBasic, PDS        168  3240     PAINTING.BAS'This was harder than I anticipated, but I was surprised at how fast it is.π'Could be made faster if the POINT functions were replaced by PEEKs but Iπ'didn't want to spend the time researching SCREEN 9 to implement themππDEFINT A-ZππSCREEN 9ππ'several shapes to show universal applicabilityππ'LINE (100, 100)-(300, 150), 4, Bπ'RECTANGLEπ'CIRCLE (112, 105), 30, 4π'CIRCLEπ' an hourglass like figureπLINE (200, 100)-(100, 50), 4πLINE (100, 50)-(300, 50), 4πLINE (300, 50)-(250, 100), 4πLINE (250, 100)-(300, 150), 4πLINE (300, 150)-(100, 150), 4πLINE (100, 150)-(200, 100), 4ππ'initv = 105   'FOR CIRCLE OR FOR RECTANGLEπ'inith = 112π'v = 105π'h = 112πinith = 225   'for the irregular polygonπinitv = 95πh = 225πv = 95πstuck = 0πfound = 0π     GOSUB makelineπ        DOπ        IF found = 1 THENπ        GOSUB relocπ        GOSUB makelineπ        END IFπ        LOOP UNTIL found <> 1ππ'relocate to initial coordinatesπ     v = initv: h = inithπ     GOSUB makeline2π     DOπ     IF found = 1 THENπ     GOSUB relocπ     GOSUB makeline2π     END IFπ     LOOP UNTIL found <> 1ππDOπA$ = INKEY$πLOOP UNTIL A$ <> ""πENDππsetpoint:π      PSET (h, v), 3πRETURNππmakeline:π'draws a line from initial position all the way to the left andπ'all the way to the right, looking for the first hole in theπ'ceiling it can find.ππ'move leftπfound = 0πholev = 0πholeh = 0π'look up before moving to see if there is a holeπDOπIF found = 0 THENπ'if no hole yet found then check for oneπIF POINT(h, v - 1) <> 4 THENπ          holev = v - 1: holeh = hπ          found = 1π     END IFπEND IFπh = h - 1ππIF POINT(h, v) <> 4 THEN   'can we move left?π  GOSUB setpoint    'mark and moveπELSEπ  h = h + 1π  stuck = 1πEND IFπLOOP UNTIL stuck = 1ππ'move rightπ'reset flagπstuck = 0πDOπIF found = 0 THEN 'if no hole yet found then check for oneπ     IF POINT(h, v - 1) <> 4 THENπ          holev = v - 1: holeh = hπ          found = 1π     END IFπEND IFπh = h + 1ππIF POINT(h, v) <> 4 THEN   'can we move right?π  GOSUB setpoint    'mark and moveπELSEπ  h = h - 1π  stuck = 1πEND IFπLOOP UNTIL stuck = 1ππstuck = 0πRETURNπππreloc:πh = holehπv = holevπRETURNππmakeline2:π'draws a line from initial position all the way to the left andπ'all the way to the right, looking for the first hole in theπ'floor it can find.ππ'move leftπfound = 0πholev = 0πholeh = 0π'look up before moving to see if there is a holeπDOπIF found = 0 THEN 'if no hole yet found then check for oneπ     IF POINT(h, v + 1) <> 4 THENπ          holev = v + 1: holeh = hπ          found = 1π     END IFπEND IFπh = h - 1ππIF POINT(h, v) <> 4 THEN   'can we move left?π  GOSUB setpoint    'mark and moveπELSEπ  h = h + 1π  stuck = 1πEND IFπLOOP UNTIL stuck = 1ππ'move rightπ'reset flagπstuck = 0πDOπIF found = 0 THEN 'if no hole yet found then check for oneπ     IF POINT(h, v + 1) <> 4 THENπ          holev = v + 1: holeh = hπ          found = 1π     END IFπEND IFπh = h + 1ππIF POINT(h, v) <> 4 THEN   'can we move right?π   GOSUB setpoint          'mark and moveπELSEπ  h = h - 1π  stuck = 1πEND IFππLOOP UNTIL stuck = 1ππstuck = 0ππRETURNππIsaac Grover                   LINE BOUNCER                   FidoNet QUIK_BAS Echo          03-18-96 (01:09)       QB, QBasic, PDS        25   1112     LNBOUNCE.BASSCREEN 12: RANDOMIZE TIMERπRow1% = INT(RND * 473) + 1: Column1% = INT(RND * 633) + 1πRow2% = INT(RND * 473) + 1: Column2% = INT(RND * 633) + 1πChangeInRow1% = 1: ChangeInColumn1% = 1πChangeInRow2% = 1: ChangeInColumn2% = 1πDO UNTIL INKEY$ <> ""π  LINE (Column1%, Row1%)-(Column2%, Row2%), 10π  IF Row1% <= 0 THEN ChangeInRow1% = -ChangeInRow1%π  IF Row1% >= 480 THEN ChangeInRow1% = -ChangeInRow1%π  IF Row2% <= 0 THEN ChangeInRow2% = -ChangeInRow2%π  IF Row2% >= 474 THEN ChangeInRow2% = -ChangeInRow2%π  IF Column1% <= 0 THEN ChangeInColumn1% = -ChangeInColumn1%π  IF Column1% >= 634 THEN ChangeInColumn1% = -ChangeInColumn1%π  IF Column2% <= 0 THEN ChangeInColumn2% = -ChangeInColumn2%π  IF Column2% >= 634 THEN ChangeInColumn2% = -ChangeInColumn2%π  OldColumn1% = Column1%: OldRow1% = Row1%π  OldColumn2% = Column2%: OldRow2% = Row2%π  Column1% = Column1% + ChangeInColumn1%π  Row1% = Row1% + ChangeInRow1%π  Column2% = Column2% + ChangeInColumn2%π  Row2% = Row2% + ChangeInRow2%π  FOR Delay% = 1 TO 5000: NEXTπ  LINE (OldColumn1%, OldRow1%)-(OldColumn2%, OldRow2%), 0πLOOP: SYSTEMππMathew Robertson               WRITE 640X480X16 .BMP FILES    FidoNet QUIK_BAS Echo          03-28-96 (17:45)       QB, QBasic, PDS        72   2834     SAVEBMP.BAS 'Programed by: Mathew Robertson    '1994π'This Is a very easy example of how to write 640x480x16 windowsπ'Bitmap files. It should not be that hard to change to make itπ'accept other sizes. The code is not commented to well so toπ'make such changes it will reguire abit of knowledge on theπ'subject and the time to make the changes, Unfortunaly I doπ'not have the time to do so. Other possible changes would beπ'to use direct memory access to read the screen instead of pointπ'which is rather slow. This type of change would make it workπ'faster on slower systems.π'Anyone who does want to make the changes and has the timeπ'to do so, go ahead. The one Restriction is if you improve onπ'the code that I get a copy of the modified code.π'This code is slow so if it looks like it has stopped its still goingπ'just after the original screen draw there is no more visual output.π'when finished running pop into your favorite graphics viewer thatπ'supports this format (most do support windows bitmaps)π'--------------------------------<cut here>----------------------------------π'Set the screen mode clear screenπSCREEN 12: CLSπ'Set up variablesπDIM B(1345), a&(16): kur = 0π'the name of the file to use to save the screen twoπfile$ = "test2.bmp"π'well this one is sort of self explainitoryπRANDOMIZE TIMERπ'Get some new colorsπFOR i = 0 TO 15πa&(i) = INT(RND * 64) + INT(RND * 64) * 256 + INT(RND * 64) * 65536πNEXTπ'Change the paletteπPALETTE USING a&(0)π'Draw something pretty on the screenπFOR i = 20 TO 400: CIRCLE (320, 240), i, i AND 15: NEXTπ'Well since we like are picture so much lets save it as a Windows BitmapπGOSUB SAVEASwBMPπ'end the programπENDπSAVEASwBMP: 'the main save routinesπ'open the file up to save to.πOPEN file$ FOR OUTPUT AS #1π'Select the Windows Bitmap dataπRESTORE wbmpdataπ'place the Windows Bitmap data into the file headerπFOR i = 0 TO 53: READ a: PRINT #1, CHR$(a); : NEXTπ'Place the colors used in the picture into the file headerπFOR i = 0 TO 15πPRINT #1, CHR$(((a&(kur + i) AND 65536 * 63) / 65536) * 4);πPRINT #1, CHR$(((a&(kur + i) AND 256 * 63) / 256) * 4);πPRINT #1, CHR$((a&(kur + i) AND 63) * 4);πPRINT #1, CHR$(0);πNEXTπ'make sure the variable point$ has nothing in itπpoint$ = ""π'start a loop for the y valueπFOR i = 479 TO 0 STEP -1π'start a loop for the x valueπFOR j = 0 TO 639 STEP 2π'collect and store color dataπpoint$ = point$ + CHR$(POINT(j, i) * 16 + POINT(j + 1, i))πNEXTπ'write color data to fileπPRINT #1, point$; : point$ = ""πNEXTπ'close fileπCLOSE : RETURNπ'information for the file header of a windows 16 color bitmapπwbmpdata:πDATA 66,77,118,88,2,0,0,0 : DATA 0,0,118,0,0,0,40,0πDATA 0,0,128,2,0,0,224,1,0 : DATA 0,1,0,4,0,0,0,0,0,0πDATA 88,2,0,132,61,0,0,132 : DATA 61,0,0,0,0,0,0,0,0,0: DATA 0,0,0,0ππStephan Doughty                GRAVITY LINES                  [e-mail]              04-12-96 (14:36)       QB, QBasic, PDS        35   2337     GRAVLINE.BAS'Written By Stephen Doughtyπ'Watch, learn, play, enjoy.ππ5 REM Gravline.BASπ10 K = 35: S = 7: I = 1                         'K must be a multiple of 7π15 RANDOMIZE TIMERπ20 DEF FNR = (INT(RND * 5) + 5)                 'Line separationπ30 DEF FNZ = (INT((RND * 2) + 1) * 2 - 3)       'Makes -1 or 1π40 DIM X(K): DIM Y(K): DIM A(K): DIM B(K): DIM H(S): DIM C(S)π50 FOR Q = 0 TO 6: READ C(Q): H(Q) = K * (S - Q) / S: NEXT Q     'Loads line separation array with dataπ60 DATA 0,4,6,14,2,1,5                       π70 X = INT(RND * 640) + 1: XB = FNR * FNZ       'Picks X,Y and A,B pointsπ80 Y = INT(RND * 480) + 1: YB = FNR * FNZ       'and line step valuesπ90 A = INT(RND * 640) + 1: AB = FNR * FNZπ100 B = INT(RND * 480) + 1: BB = FNR * FNZπ110 G1 = FNZ: G2 = FNZ                          'Gravity (- or +)π120 SCREEN 12π130 M = X - A: N = Y - B: XY = (M * M + N * N): IF XY < 10 THEN G1 = -G1: G2 = -G2          'Lines 130-150 are a Gravity routineπ140 XB = XB - 100 * (G1 * M + XB / 3) / XY: YB = YB - 100 * (G1 * N + YB / 3) / XYπ150 AB = AB - 100 * (G2 * M + AB / 3) / XY: BB = BB - 100 * (G2 * N + BB / 3) / XYπ160 IF X + XB < 0 OR X + XB > 640 THEN XB = -SGN(XB) * FNR: YB = YB * FNZ: G1 = -SGN(G1)    'Checks for edges of screenπ170 IF Y + YB < 0 OR Y + YB > 480 THEN YB = -SGN(YB) * FNR: XB = XB * FNZ: G1 = -SGN(G1)    'if off screen then change line variableπ180 IF A + AB < 0 OR A + AB > 640 THEN AB = -SGN(AB) * FNR: BB = BB * FNZ: G2 = -SGN(G2)    'and change gravityπ190 IF B + BB < 0 OR B + BB > 480 THEN BB = -SGN(BB) * FNR: AB = AB * FNZ: G2 = -SGN(G2)π200 X = X + XB: Y = Y + YB: A = A + AB: B = B + BB      'Adds movement variables to XY coordinatesπ210 X(I) = X: Y(I) = Y: A(I) = A: B(I) = B              'Puts points in an arrayπ220 I = I + 1 + ((I = K) * K)                           'increments point arrayπ230 FOR Q = 6 TO 0 STEP -1                              'for next loop for color and eraseπ240 J = I + H(Q) + (I + H(Q) > K) * K                   'Divides array for color changeπ250 LINE (X(J), Y(J))-(A(J), B(J)), C(Q)π260 LINE (640 - X(J), 480 - Y(J))-(640 - A(J), 480 - B(J)), C(Q)π270 LINE (X(J), 480 - Y(J))-(A(J), 480 - B(J)), C(Q)π280 LINE (640 - X(J), Y(J))-(640 - A(J), B(J)), C(Q)π290 NEXT Qπ300 IF INKEY$ <> "" THEN END ELSE 130                   'Used to escapeπStephan Doughty                BOUNCING LINES IN 3D BOX       [e-mail]              04-11-96 (13:51)       QB, QBasic, PDS        83   4971     BOWBOX.BAS  'This program is the first I have writen in 15 years. This explains the archaicπ'code used. You may play with it any way you please. I will try to explain itπ'with REM statements. It is a try at displaying three dots (xyz axis) and bouncingπ'them around a three-D cube. I have also tried to implement a kind of gravityπ'factor for each dot (- or +). the palette is played with also. And an attempt atπ'making the lines "fade" as they grow "old". Have fun, Stephen Doughtyπ'To contact me please use email address, [e-mail] (its a work address)π10 REM BOWBOX.BAS                 'program nameπ20 K = 6 * 4: S = 6: I = 1        'K must be a multiple of 6 to work properlyπ30 RANDOMIZE TIMER: SCREEN 12     'sets SCREEN and RNDπ40 DEF FNR = RND * 4 + 4          'determines line spacingπ50 DEF FNZ = INT((RND * 2) + 1) * 2 - 3       'Picks a number (-1 or 1)π60 DIM X(K): DIM Y(K): DIM Z(K): DIM A(K): DIM B(K): DIM C(K) 'XYZ ABC PQR are for holding line cordinatesπ70 DIM P(K): DIM Q(K): DIM R(K): DIM H(S)                     'H is for line redraw for fading linesπ80 FOR H = 1 TO 6: H(H) = K * (S - H) / S: NEXT H             'sets up line spacing using Kπ86 FOR S = 1 TO 13 STEP 3                          'Loads palettes for each lineπ88 PALETTE S, (S + 3) * 4 - 1                      'Redπ90 PALETTE S + 1, (S + 2) * 4 + (S + 2) * 4 * 256  'Greenπ92 PALETTE S + 2, (S + 1) * 4 * 65536              'Blueπ96 NEXT Sπ100 X = RND * 300 + 1: XB = FNR * FNZ              'Picks line coordinates forπ110 Y = RND * 300 + 1: YB = FNR * FNZ              'XYZ ABC PQR and there movement factorπ120 Z = RND * 300 + 1: ZB = FNR * FNZπ130 A = RND * 300 + 1: AB = FNR * FNZπ140 B = RND * 300 + 1: BB = FNR * FNZπ150 C = RND * 300 + 1: CB = FNR * FNZπ160 P = RND * 300 + 1: PB = FNR * FNZπ170 Q = RND * 300 + 1: QB = FNR * FNZπ180 R = RND * 300 + 1: RB = FNR * FNZπ190 G1 = FNZ: G2 = FNZ: G3 = FNZ                   'Initializes Gravity for each dot (- or +)π210 M1 = X - A: N1 = Y - B: O1 = Z - C             '210 to 260 set variables for gravity routineπ220 M2 = X - P: N2 = Y - Q: O2 = Z - Rπ230 M3 = A - P: N3 = B - Q: O3 = A - Rπ240 XYZ = SQR(M1 * M1 + N1 * N1 + O1 * O1)π250 ABC = SQR(M2 * M2 + N2 * N2 + O2 * O2)π260 PQR = SQR(M3 * M3 + N3 * N3 + O3 * O3)π270 IF XYZ < 10 THEN G1 = -G1: G2 = -G2            'If dots are to close together then change gravityπ280 IF ABC < 10 THEN G1 = -G1: G3 = -G3π290 IF PQR < 10 THEN G2 = -G2: G3 = -G3π300 XB = XB - G1 * (M1 + M2) / (XYZ + ABC)         ' Gravity routine (I think)π310 YB = YB - G1 * (N1 + N2) / (XYZ + ABC)         ' May not be correctπ320 ZB = ZB - G1 * (O1 + O2) / (XYZ + ABC)π330 AB = AB - G2 * (M1 + M3) / (XYZ + PQR)π340 BB = BB - G2 * (N1 + N3) / (XYZ + PQR)π350 CB = CB - G2 * (O1 + O3) / (XYZ + PQR)π360 PB = PB - G3 * (M2 + M3) / (ABC + PQR)π370 QB = QB - G3 * (N2 + N3) / (ABC + PQR)π380 RB = RB - G3 * (O2 + O3) / (ABC + PQR)π390 IF X + XB < 0 OR X + XB > 300 THEN XB = -SGN(XB) * FNR: G1 = -G1    'Checks for out-of-boundsπ400 IF Y + YB < 0 OR Y + YB > 300 THEN YB = -SGN(YB) * FNR: G1 = -G1    'if so, it changes movement factorπ410 IF Z + ZB < 0 OR Z + ZB > 300 THEN ZB = -SGN(ZB) * FNR: G1 = -G1    'and gravityπ420 IF A + AB < 0 OR A + AB > 300 THEN AB = -SGN(AB) * FNR: G2 = -G2π430 IF B + BB < 0 OR B + BB > 300 THEN BB = -SGN(BB) * FNR: G2 = -G2π440 IF C + CB < 0 OR C + CB > 300 THEN CB = -SGN(CB) * FNR: G2 = -G2π450 IF P + PB < 0 OR P + PB > 300 THEN PB = -SGN(PB) * FNR: G3 = -G3π460 IF Q + QB < 0 OR Q + QB > 300 THEN QB = -SGN(QB) * FNR: G3 = -G3π470 IF R + RB < 0 OR R + RB > 300 THEN RB = -SGN(RB) * FNR: G3 = -G3π480 X = X + XB: Y = Y + YB: Z = Z + ZB        'Adds line and movement factor togetherπ490 A = A + AB: B = B + BB: C = C + CBπ500 P = P + PB: Q = Q + QB: R = R + RBπ510 X(I) = X: Y(I) = Y: Z(I) = Z              'Remembers lines in arrayπ520 A(I) = A: B(I) = B: C(I) = C              'for fade routine andπ530 P(I) = P: Q(I) = Q: R(I) = R              'eraseπ540 I = I + 1 + ((I = K) * K)                 'Cycles line by adding one, if >K then (1) againπ545 GOSUB 1000: S = 16                        'Gosub 1000 refreshes cube. S is palette informationπ550 FOR H = 1 TO 6π560 J = I + H(H) + (I + H(H) > K) * K         'Which line fades nextπ565 S = S - 1π580 LINE (X(J) + Z(J) / 2, Y(J) + Z(J) / 2)-(A(J) + C(J) / 2, B(J) + C(J) / 2), Sπ585 S = S - 1 - (S = 0)π590 LINE (A(J) + C(J) / 2, B(J) + C(J) / 2)-(P(J) + R(J) / 2, Q(J) + R(J) / 2), Sπ595 S = S - 1 - (S = 0)π600 LINE (P(J) + R(J) / 2, Q(J) + R(J) / 2)-(X(J) + Z(J) / 2, Y(J) + Z(J) / 2), Sπ610 NEXT Hπ620 IF INKEY$ <> "" THEN END ELSE 210         'if any key then stopπ1000 COLOR 7                                  'Subroutine for cubeπ1010 LINE (0, 0)-(300, 300), , Bπ1050 LINE (150, 150)-(450, 450), , Bπ1090 LINE (0, 0)-(150, 150)π1100 LINE (0, 300)-(150, 450)π1110 LINE (300, 300)-(450, 450)π1120 LINE (300, 0)-(450, 150)π1130 RETURNπRichard Dale                   FLYING BEES & WASP             FidoNet QUIK_BAS Echo          04-21-96 (09:47)       QB, QBasic, PDS        90   3442     FLYBEES.BAS ' Works best when number of bees is 5 to 100 in INPUT statement for aπ' 386, slightly higher on 486.  Experiment, though.  A really highπ' number can provide a visual excitement, though may take some time toπ' set up the display.  May not run on CGA.  All I have is VGA.πDECLARE SUB wasp (wx%(), wy%())πDECLARE SUB bees (wx%(), wy%(), x%(), y%(), xv%(), yv%(), bcolor%)πDEFINT A-ZπCOMMON SHARED winW, winH, winX, winY, border, NoBeesπDEFLNG T: CLSπINPUT "Number of bees (1 to 10000)"; NoBeesπIF NoBees < 1 OR NoBees > 10000 THEN RUNπSCREEN 12: RANDOMIZE TIMER: CLSπDIM wx(0 TO 2): DIM wy(0 TO 2)πDIM x(0 TO 2, 1 TO NoBees): DIM y(0 TO 2, 1 TO NoBees)πDIM xv(1 TO NoBees): DIM yv(1 TO NoBees)πwinW = 0: winH = 0: winX = 0: winY = 0: maxx = 640: maxy = 480π' wasp will not go closer than this to the edgesπ    border = INT(RND * 75): winW = maxx: winH = maxyπ' Initialize the waspπ    wx(0) = 640 / 2: wy(0) = 480 / 2: wx(1) = wx(0): wy(1) = wy(0)π'Initialize the beesπ    FOR b = 1 TO NoBeesπ        x(0, b) = INT(RND * winW): x(1, b) = x(0, b)π        y(0, b) = INT(RND * winH): y(1, b) = y(0, b)π        xv(b) = 7 * (RND - .5): yv(b) = 7 * (RND - .5)π    NEXT bπ    bcolor = 9: t1 = TIMERπ    DO UNTIL INKEY$ <> ""π    CALL wasp(wx(), wy()):CALL bees(wx(), wy(), x(), y(), xv(), yv(), bcolor)π' change bee colorsπ    IF TIMER - t1 > 2 THENπ        bcolor = bcolor + 1π        IF bcolor = 14 THEN bcolor = 9π        t1 = TIMERπ    END IFπ    LOOP: SCREEN 0πENDπDEFINT TπSUB bees (wx(), wy(), x(), y(), xv(), yv(), bcolor)π' Do not let things settle downπ    bb = INT(NoBees * RND + 1)π    xv(bb) = xv(bb) + (RND - .5) * 3: yv(bb) = yv(bb) + (RND - .5) * 3πFOR b = 1 TO NoBeesπ' Age position arraysπ    x(2, b) = x(1, b): y(2, b) = y(1, b)π    x(1, b) = x(0, b): y(1, b) = y(0, b)π    dx = wx(1) - x(1, b): dy = wy(1) - y(1, b)π    distance = ABS(dx) + ABS(dy)    ' Approximationπ    IF distance = 0 THEN distance = 1π    bee.acc = 3π' Accelerateπ    xv(b) = xv(b) + dx * bee.acc / distanceπ    yv(b) = yv(b) + dy * bee.acc / distanceπ    bee.vel = 11π' Speed Checksπ    IF xv(b) > bee.vel THEN xv(b) = bee.velπ    IF xv(b) < -bee.vel THEN xv(b) = -bee.velπ    IF yv(b) > bee.vel THEN yv(b) = bee.velπ    IF yv(b) < -bee.vel THEN yv(b) = -bee.velπ' Move the beesπ    x(0, b) = x(1, b) + xv(b): y(0, b) = y(1, b) + yv(b)π    LINE (x(1, b), y(1, b))-(x(2, b), y(2, b)), 0π    LINE (x(0, b), y(0, b))-(x(1, b), y(1, b)), bcolorπNEXT bπEND SUBπSUB wasp (wx(), wy()) STATICπ' Age the arraysπ    wx(2) = wx(1): wx(1) = wx(0): wy(2) = wy(1): wy(1) = wy(0)π' Accelerate (bias random variable to ensure wasp convers entire screen)π    wasp.acc = 5π    wxv = wxv + INT((RND - .4) * wasp.acc)π    wyv = wyv + INT((RND - .4) * wasp.acc)π' Speed limit checksπ    wxv.max = INT(RND * 30) + 20: wyv.max = INT(RND * 30) + 20π    IF wxv > wxv.max THEN wxv = wxv.maxπ    IF wxv < -wxv.max THEN wxv = -wxv.maxπ    IF wyv > wyv.max THEN wyv = wyv.maxπ    IF wyv < -wyv.max THEN wyv = -wyv.maxπ' Move waspπ    wx(0) = wx(1) + wxv: wy(0) = wy(1) + wyvπ' Bounce checksπ    IF wx(0) < border OR wx(0) > winW - border - 1 THENπ        wxv = -wxv: wx(0) = wx(0) + wxvπ    END IFπ    IF wy(0) < border OR wy(0) > winH - border - 1 THENπ        wyv = -wyv: wy(0) = wy(0) + wyvπ    END IFπ    LINE (wx(1), wy(1))-(wx(2), wy(2)), 0π    LINE (wx(0), wy(0))-(wx(1), wy(1)), 15πEND SUBπMike Huff                      VGA/SVGA INTERRUPTS            FidoNet QUIK_BAS Echo          03-03-96 (20:38)       Text                   26   1180     GRAPHICS.FAQ'> inreg.ax = &H1C ' Sets 640X480X256 mode π'> CALL INTERRUPT(&H10, inreg, outreg)ππThis routine doesn't work so great on my machine (or at least my Trident VESAπcard.) You used the wrong value for the AX register. Here's a list thatπshould work on any VGA/SVGA machine:ππAX      Resolution     Text H/W         Segment      π--------------------------------------------------------------------------π5Ch for 640x400x256     (80x25)          A000h       π5Dh for 640x480x256     (80x30)          A000hπ6Ch for 640x480x16M     (80x30)          A000h       π5Bh for 800x600x16      (100x75)         A000h       π5Eh for 800x600x256     (100x75)         A000h       π5Fh for 1024x768x16     (128x48)         A000h       π62h for 1024x768x256    (128x48)         A000h       π63h for 1280x1024x16    (160x64)         A000h       π64h for 1280x1024x256   (160x64)         A000h       ππSome of the higher res or color modes may not work on every video card.πYou should also use direct memory writes instead of the extremely slow BIOSπ"PSET" routines. Here's an example in case you don't know:ππDEF SEG = &HA000πPOKE (Xmax& * Y& + X&), TheColorYaWant%πDEF SEGπWim Osterholt                  I/O PORT ADDRESSES             FidoNet QUIK_BAS Echo          02-06-94 (08:29)       Text                   2114 78926    PORTS.LST   [This file was provided by Wim Osterholt (2:512/56.198).]πLast Change: 2/6/94ππππ        XT, AT and PS/2     I/O port addressesππ      Do NOT consider this information as complete and accurate.π      If you want to do harware programming check ALWAYS theπ      appropriate data sheets. Be aware that erroneously programmingπ      can put your hardware or your data at risk. ππ      There is a memory mapped address in use for I/O functions of which Iπ      think it should be mentioned here. See at the end of this list.ππ-------------------------------------------------------------------------------π0000-001F ----    DMA 1    (first Direct Memory Access controller 8237)ππ0000    r/w    DMA channel 0  address    byte  0, then byte 1.π0001    r/w    DMA channel 0 word count byte 0, then byte 1.π0002    r/w    DMA channel 1  address    byte  0, then byte 1.π0003    r/w    DMA channel 1 word count byte 0, then byte 1.π0004    r/w    DMA channel 2  address    byte  0, then byte 1.π0005    r/w    DMA channel 2 word count byte 0, then byte 1.π0006    r/w    DMA channel 3  address    byte  0, then byte 1.π0007    r/w    DMA channel 3 word count byte 0, then byte 1.ππ0008    r    DMA channel 0-3 status registerπ         bit 7 = 1  channel 3 requestπ         bit 6 = 1  channel 2 requestπ         bit 5 = 1  channel 1 requestπ         bit 4 = 1  channel 0 requestπ         bit 3 = 1  channel terminal count on channel 3π         bit 2 = 1  channel terminal count on channel 2π         bit 1 = 1  channel terminal count on channel 1π         bit 0 = 1  channel terminal count on channel 0ππ0008    w    DMA channel 0-3 command registerπ         bit 7 = 1  DACK sense active highπ               = 0  DACK sense active lowπ         bit 6 = 1  DREQ sense active highπ               = 0  DREQ sense active lowπ         bit 5 = 1  extended write selectionπ               = 0  late write selectionπ         bit 4 = 1  rotating priorityπ               = 0  fixed priorityπ         bit 3 = 1  compressed timingπ               = 0  normal timingπ         bit 2 = 1  enable controllerπ               = 0  enable memory-to-memoryππ0009    w    DMA write request registerππ000A    r/w    DMA channel 0-3 mask registerπ         bit 7-3 = 0   reservedπ         bit 2     = 0   clear mask bitπ             = 1   set mask bitπ         bit 1-0 = 00  channel 0 selectπ             = 01  channel 1 selectπ             = 10  channel 2 selectπ             = 11  channel 3 selectππ000B    w    DMA channel 0-3 mode registerπ         bit 7-6 = 00  demand modeπ             = 01  single modeπ             = 10  block modeπ             = 11  cascade modeπ         bit 5     = 0   address increment selectπ             = 1   address decrement selectπ         bit 3-2 = 00  verify operationπ             = 01  write to memoryπ             = 10  read from memoryπ             = 11  reservedπ         bit 1-0 = 00  channel 0 selectπ             = 01  channel 1 selectπ             = 10  channel 2 selectπ             = 11  channel 3 selectππ000C    w    DMA clear byte pointer flip-flopπ000D    r    DMA read temporary registerπ000D    w    DMA master clearπ000E    w    DMA clear mask registerπ000F    w    DMA write mask registerππ-------------------------------------------------------------------------------π0010-001F ----    DMA controller (8237) on PS/2 model 60 & 80ππ-------------------------------------------------------------------------------π0018    w    PS/2 extended function registerππ-------------------------------------------------------------------------------π001A        PS/2 extended function executeππ-------------------------------------------------------------------------------π0020-003F ----    PIC 1    (Programmable Interrupt Controller 8259)ππ0020    w    PIC initialization command word ICW1π         bit 7-5 = 0  only used in 80/85 modeπ         bit 4     = 1  ICW1 is being issuedπ         bit 3     = 0  edge triggered modeπ             = 1  level triggered modeπ         bit 2     = 0  successive interrupt vectors use 8 bytesπ             = 1  successive interrupt vectors use 4 bytesπ         bit 1     = 0  cascade modeπ             = 1  single mode, no ICW3 neededπ         bit 0     = 0  no ICW4 neededπ             = 1  ICW4 neededππ0021    w    PIC  ICW2,ICW3,ICW4 after ICW1 to 0020π        ICW2:π         bit 7-3 = address lines A0-A3 of base vector address for PICπ         bit 2-0 = reservedπ        ICW3:π         bit 7-0 = 0  slave controller not attached to correspondingπ                  interrupt pinπ             = 1  slave controller attached to correspondingπ                  interrupt pinπ        ICW4:π         bit 7-5 = 0  reservedπ         bit 4     = 0  no special fully-nested modeπ             = 1  special fully-nested modeπ         bit 3-2 = 0x nonbuffered modeπ             = 10 buffered mode/slaveπ             = 11 buffered mode/masterπ         bit 1     = 0  normal EOIπ             = 1  Auto EOIπ         bit 0     = 0  8085 modeπ             = 1  8086/8088 modeππ0021    r/w    PIC master interrupt mask registerπ        OCW1:π         bit 7 = 0  enable parallel printer interruptπ         bit 6 = 0  enable diskette interruptπ         bit 5 = 0  enable fixed disk interruptπ         bit 4 = 0  enable serial port 1 interruptπ         bit 3 = 0  enable serial port 2 interruptπ         bit 2 = 0  enable video interruptπ         bit 1 = 0  enable keyboard, mouse, RTC interruptπ         bit 0 = 0  enable timer interruptπ        OCW2:π         bit 7-5 = 000    rotate in auto EOI mode (clear)π             = 001    nonspecific EOIπ             = 010    no operationπ             = 011    specific EOIπ             = 100    rotate in auto EOI mode (set)π             = 101    rotate on nonspecific EOI commandπ             = 110    set priority commandπ             = 111    rotate on specific EOI commandπ         bit 4     = 0    reservedπ         bit 3     = 0    reservedπ         bit 2-0    interrupt request to which the command appliesππ0020    r    PIC  interrupt request/in-service registers by OCW3π        request register:π         bit 7-0 = 0  no active request for the corresponding int. lineπ             = 1  active request for corresponding interrupt lineπ        in-service register:π         bit 7-0 = 0  corresponding line not currently being servicedπ             = 1  corresponding int. line currently being servicedππ0020    w    PIC OCW3π         bit 7     = 0   reservedπ         bit 6-5 = 0x  no operationπ             = 10  reset special maskπ             = 11  set special maskπ         bit 4     = 0   reservedπ         bit 3     = 1   reservedπ         bit 2     = 0   no poll commandπ             = 1   poll commandπ         bit 1-0 = 0x  no operationπ             = 10  read int.request register on next read at 0020π             = 11  read int.in-service register on next read 0020ππ-------------------------------------------------------------------------------π0022-002B ----    Intel 82355, part of chipset for 386sxπ         initialisation in POST will disable these addresses,π         only a hard reset will enable them again.ππ0022    r/w    82335 MCR memory configuration registerπ0024        82335 RC1 roll compare registerπ0026        82335 RC2 roll compare registerπ0028        82335 CC0 compare registerπ002A        82335 CC1 compare registerππ          values for CC0 and CC1:π          00F9,0000  enable range compare CC0 0-512K  CC1 disableπ          00F1,0000  enable range compare CC0 0-1024K CC1 disableπ          00F1,10F9  enable range compare CC0 0-1M    CC1 1M-1M5π          00E1,0000  enable range compare CC0 0-2M    CC1 disableπ          00E1,0000  enable range compare CC0 0-2M    CC1 disableπ          00C1,0000  enable range compare CC0 0-4M    CC1 disableπ          00C1,40E1  enable range compare CC0 0-4M    CC1 4M-6Mπ          0081,0000  enable range compare CC0 0-8M    CC1 disableππ-------------------------------------------------------------------------------π0038-003F ----    PC radio by CoZet Info Systemsπ        The I/O address range is dipswitch selectable from:π           038-03F and 0B0-0BFπ           078-07F and 0F9-0FFπ           138-13F and 1B0-1BFπ           178-17F and 1F9-1FFπ           238-23F and 2B0-2BFπ           278-27F and 2F0-2FFπ           338-33F and 3B0-3BFπ           378-37F and 3F0-3FFπ        All of these addresses show a readout of FF in initial state.π        Once started, all of the addresses show     FB, whatever mightπ        happen.ππ-------------------------------------------------------------------------------π0040-005F ----    PIT  (Programmable Interrupt Timer  8253, 8254)π         XT & AT uses 40-43    PS/2 uses 40, 42,43,44, 47ππ0040    r/w    PIT  counter 0, counter divisor          (XT, AT, PS/2)π0041    r/w    PIT  counter 1, RAM refresh counter   (XT, AT)π0042    r/w    PIT  counter 2, cassette & speaker    (XT, AT, PS/2)ππ0043    r/w    PIT  mode port, control word register for counters 0-2π         bit 7-6 = 00  counter 0 selectπ             = 01  counter 1 select      (not PS/2)π             = 10  counter 2 selectπ         bit 5-4 = 00  counter latch commandπ             = 01  read/write counter bits 0-7 onlyπ             = 10  read/write counter bits 8-15 onlyπ             = 11  read/write counter bits 0-7 first, then 8-15π         bit 3-1 = 000 mode 0 selectπ             = 001 mode 1 select - programmable one shotπ             = x10 mode 2 select - rate generatorπ             = x11 mode 3 select - square wave generatorπ             = 100 mode 4 select - software triggered strobeπ             = 101 mode 5 select - hardware triggered strobeπ         bit 0     = 0   binary counter 16 bitsπ             = 1   BCD counterππ0044    r/w    PIT  counter 3 (PS/2, EISA)π        used as fail-safe timer. generates an NMI on time out.π        for user generated NMI see at 0462.ππ0047    w    PIT  control word register counter 3 (PS/2, EISA)π         bit 7-6 = 00  counter 3 selectπ             = 01  reservedπ             = 10  reservedπ             = 11  reservedπ         bit 5-4 = 00  counter latch command counter 3π             = 01  read/write counter bits 0-7 onlyπ             = 1x  reservedπ         bit 3-0 = 00ππ0048        EISAπ004A        EISAπ004B        EISAππ-------------------------------------------------------------------------------π0060-006F ----    Keyboard controller (8041, 8042)  (or PPI (8255) on XT)π         XT uses 60-63,     AT uses 60-64ππ         AT keyboard controller input port bit definitionsπ          bit 7      = 0  keyboard inhibitedπ          bit 6      = 0  CGA, else MDAπ          bit 5      = 0  manufacturing jumper installedπ          bit 4      = 0  system RAM 512K, else 640Kπ          bit 3-0      reservedππ         AT keyboard controller input port bit definitions by Compaqπ          bit 7      = 0  security lock is lockedπ          bit 6      = 0  Compaq dual-scan display, 1=non-Compaq displayπ          bit 5      = 0  system board dip switch 5 is ONπ          bit 4      = 0  auto speed selected, 1=high speed selectedπ          bit 3      = 0  slow (4MHz), 1 = fast (8MHz)π          bit 2      = 0  80287 installed, 1= no NDP installedπ          bit 1-0      reservedππ         AT keyboard controller output port bit definitionsπ          bit 7 =    keyboard data outputπ          bit 6 =    keyboard clock outputπ          bit 5 = 0  input buffer fullπ          bit 4 = 0  output buffer emptyπ          bit 3 =    reserved (see note)π          bit 2 =    reserved (see note)π          bit 1 =    gate A20π          bit 0 =    system resetπ        Note:    bits 2 and 3 are the turbo speed switch or passwordπ              lock on Award/AMI/Phoenix BIOSes.  These bits makeπ              use of nonstandard keyboard controller BIOSπ              functionality to manipulateπ                pin 23 (8041 port 22) as turbo switch for AWARDπ                pin 35 (8041 port 15) as turbo switch/pw lock forπ                Phoenixππ0060    r/w    KB controller data port or keyboard input buffer (ISA, EISA)π        should only be read from after status port bit0 = 1π        should only be written to if status port bit1 = 0π        keyboard commands (data goes also to port 0060):π         ED    dbl   set/reset mode indicators Caps Num Scrlπ         EE    sngl  diagnostic echo. returns EE.π         EF-F2    sngl  NOP (No OPeration). reserved for future useπ         F3    dbl   set typematic rate/delayπ         F4    sngl  enable keyboardπ         F5    sngl  disable keyboard. set default parametersπ         F6    sngl  set default parametersπ         F7-FD    sngl  NOPπ         FE    sngl  resend last scancodeπ         FF    sngl  perform internal power-on reset functionπππ0060    r    KeyBoard or KB controller data output buffer (via PPI on XT)ππ0061    w    KB controller port B (ISA, EISA)   (PS/2 port A is at 0092)π        system control port for compatibility with 8255π         bit 7    (1= IRQ 0 reset )π         bit 6-4    reservedπ         bit 3 = 1  channel check enableπ         bit 2 = 1  parity check enableπ         bit 1 = 1  speaker data enableπ         bit 0 = 1  timer 2 gate to speaker enableππ0061    r    KB controller port B control register (ISA, EISA)π        system control port for compatibility with 8255π         bit 7     parity check occurredπ         bit 6     channel check occurredπ         bit 5     mirrors timer 2 output conditionπ         bit 4     toggles with each refresh requestπ         bit 3     channel check statusπ         bit 2     parity check statusπ         bit 1     speaker data statusπ         bit 0     timer 2 gate to speaker statusππ0061    w    PPI  Programmable Peripheral Interface 8255 (XT only)π        system control portπ         bit 7 = 1  clear keyboardπ         bit 6 = 0  hold keyboard clock lowπ         bit 5 = 0  I/O check enableπ         bit 4 = 0  RAM parity check enableπ         bit 3 = 0  read low switchesπ         bit 2        reserved, often used as turbo switchπ         bit 1 = 1  speaker data enableπ         bit 0 = 1  timer 2 gate to speaker enableππ0062    r/w    PPI (XT only)π         bit 7 = 1  RAM parity checkπ         bit 6 = 1  I/O channel checkπ         bit 5 = 1  timer 2 channel outπ         bit 4        reserved π         bit 3 = 1  system board RAM size type 1π         bit 2 = 1  system board RAM size type 2π         bit 1 = 1  coprocessor installedπ         bit 0 = 1  loop in POSTππ0063    r/w    PPI (XT only) command mode register  (read dipswitches)π         bit 7-6 = 00  1 diskette driveπ             = 01  2 diskette drivesπ             = 10  3 diskette drivesπ             = 11  4 diskette drivesπ         bit 5-4 = 00  reservedπ             = 01  40*25 color (mono mode)π             = 10  80*25 color (mono mode)π             = 11  MDA 80*25π         bit 3-2 = 00  256K (using 256K chips)π             = 01  512K (using 256K chips)π             = 10  576K (using 256K chips)π             = 11  640K (using 256K chips)π         bit 3-2 = 00  64K  (using 64K chips)π             = 01  128K (using 64K chips)π             = 10  192K (using 64K chips)π             = 11  256K (using 64K chips)π         bit 1-0       reservedππ0064    r    KB controller read status (ISA, EISA)π         bit 7 = 1 parity error on transmission from keyboardπ         bit 6 = 1 receive timeoutπ         bit 5 = 1 transmit timeoutπ         bit 4 = 0 keyboard inhibitπ         bit 3 = 1 data in input register is commandπ             0 data in input register is dataπ         bit 2 = 0 system flag status 0=power up or reset 1=selftest OKπ         bit 1 = 1 input buffer full (input 60/64 has data for 8042)π         bit 0 = 1 output buffer full (output 60 has data for system)ππ0064    r     KB controller read status by Compaqπ         bit 7 = 1 parity error detected (11-bit format only). If anπ               error is detected, a Resend command is sent to theπ               keyboard once only, as an attempt to recover.π         bit 6 = 1 receive timeout. transmission didn't finish in 2mS.π         bit 5 = 1 transmission timeout errorπ                bit 5,6,7  causeπ                1 0 0  No clockπ                1 1 0  Clock OK, no responseπ                1 0 1  Clock OK, parity errorπ         bit 4 = 0 security lock engagedπ         bit 3 = 1 data in OUTPUT register is commandπ             0 data in OUTPUT register is dataπ         bit 2 = 0 system flag status 0=power up or reset 1=soft resetπ         bit 1 = 1 input buffer full (output 60/64 has data)π         bit 0 = 0 no new data in buffer (input 60 has data)ππ0064    w    KB controller input buffer (ISA, EISA)π        KB controller commands (data goes to port 0060):π         20    read  read byte zero of internal RAM, this is theπ                  last KB command send to 8041π              Compaq  Put current command byte on port 0060π                command structure:π                bit 7    reservedπ                bit 6 = 1 convert KB codes to 8086 scan codesπ                bit 5 = 0 use 11-bit codes, 1=use 8086 codesπ                bit 4 = 0 enable keyboard, 1=disable keyboardπ                bit 3 = 1 ignore security lock stateπ                bit 2      this bit goes into bit2 status reg.π                bit 1 = 0 reservedπ                bit 0 = 1 generate int. when output buffer fullπ         21-3F    read  reads the byte specified in the lower 5 bits ofπ                  the command in the 8041's internal RAMπ         60-7F    dbl   writes the data byte to the address specified inπ                  the 5 lower bits of the command.ππ                  Alternate description KB IO command 60 summary:π                   bit7 = 0 reservedπ                   bit6 =    IBM PC compatibility modeπ                   bit5 =    IBM PC modeπ                   bit4 =    disable kbπ                   bit3 =    inhibit overrideπ                   bit2 =    system flagπ                   bit1 = 0 reservedπ                   bit0 =    enableoutput buffer full interruptππ         60   Compaq  Load new command (60 to [64], command to [60])π         A1   Compaq  unknown speedfunction ??π         A2   Compaq  unknown speedfunction ??π         A3   Compaq  Enable system speed controlπ         A4   Compaq  Toggle speedπ         A5   Compaq  Special reed. the 8042 places the real valuesπ                  of port 2 except for bits 4 and 5 wich are givenπ                  a new definition in the output buffer. No outputπ                  buffer full is generated.π                if bit 5 = 0, a 9-bit keyboard is in useπ                if bit 5 = 1, an 11-bit keyboard is in useπ                if bit 4 = 0, outp-buff-full interrupt disabledπ                if bit 4 = 1, output-buffer-full int. enabledπ         A6   Compaq  unknown speedfunction ??π         AA    sngl  initiate self-test. will return 55 to data portπ              Compaq  Initializes ports 1 and 2, disables the keyboardπ                  and clears the buffer pointers. It then placesπ                  55 in the output buffer.π         AB    sngl  initiate interface test. result values:π                   0 = no errorπ                   1 = keyboard clock line stuck lowπ                   2 = keyboard clock line stuck highπ                   3 = keyboard data line is stuck lowπ                   4 = keyboard data line stuck highπ              Compaq   5 = Compaq diagnostic featureπ         AC    read  diagnostic dump. the contents of the 8041 RAM,π                  output port, input port, status word are send.π         AD    sngl  disable keyboard (sets bit 4 of commmand byte)π         AE    sngl  enable keyboard  (resets bit 4 of commmand byte)π         AF    AWARD Enhanced Command: read keyboard versionπ         C0    read  read input portπ              Compaq  Places status of input port in output buffer. useπ                  this command only when the output buffer is emptyπ         C1    AWARD Enhanced Command: poll input port Low nibbleπ         C2    AWARD Enhanced Command: poll input port High nibbleπ         D0    read  read output portπ              Compaq  Places byte in output port in output buffer. useπ                  this command only when the output buffer is emptyπ         D1    dbl   write output port. next byte written  to 0060π                  will be written to the 8041 output portπ              Compaq  The system speed bits are not set by this commandπ                  use commands A1-A6 (!) for speed functions.π         D2    AWARD Enhanced Command: write keyboard output bufferπ         D3    AWARD Enhanced Command: write pointing device out.buf.π         D4    AWARD Enhanced Command: write to auxiliary deviceπ         DD    sngl  disable address line A20. default in Real Modeπ         DF    sngl  enable address line A20π         E0    read  read test inputs. bit0 = T0 and bit1 = T1π         Exx    AWARD Enhanced Command: active output portπ         ED   Compaq  This is a two part command to control the stateπ                  of the NumLock CpasLock and ScrollLock LEDsπ                  The second byte contains the state to set LEDs.π                bit 7-3       reserved. should be set to 0.π                bit 2 = 0  Caps Lock LED offπ                bit 1 = 0  Num Lock LED offπ                bit 0 = 0  Scroll Lock LED offπ         F0-FF    sngl  pulse output port low for 6 microseconds.π                  bits 0-3 contain the mask for the bits to beπ                  pulsed. a bit is pulsed if its mask bit is zero.π                  bit0=system reset. Don't set to zero. Pulse only!ππgeneral note:     Keyboard controllers are widely different from each other.π         You cannot generally exchange them between different machines.πnote on Award:     Derived from Award's Enhanced KB controller advertising sheet.πnote on Compaq:     Derived from the Compaq Deskpro 386 Tech. Ref. Guide.ππ0065    r    communications port (Olivetti M24)ππ0068    w    HP-Vectra  control buffer (HP commands)π0069    r    HP-Vectra  SVC (keyboard request SerViCe port)π006A    w    HP-Vectra  clear processing, doneππ006C-006F    HP-HIL    (Human Interface Link = async. serial inputs 0-7)ππ-------------------------------------------------------------------------------π0070-007F ----    CMOS RAM/RTC (Real Time Clock  MC146818)ππ0070    w    CMOS RAM index register port (ISA, EISA)π         bit 7     = 1  NMI disabledπ             = 0  NMI enabledπ         bit 6-0      CMOS RAM index (64 bytes, sometimes 128 bytes)ππ        any write to 0070 should be followed by an action to 0071π        or the RTC wil be left in an unknown state.ππ0071    r/w    CMOS RAM data port (ISA, EISA)π        RTC registers:π        00    current second in BCDπ        01    alarm second   in BCDπ        02    current minute in BCDπ        03    alarm minute   in BCDπ        04    current hour in BCDπ        05    alarm hour   in BCDπ        06    day of week  in BCDπ        07    day of month in BCDπ        08    month in BCDπ        09    year  in BCD (00-99)π        0A    status register Aπ               bit 7 = 1  update in progressπ               bit 6-4 divider that identifies the time-basedπ                frequencyπ               bit 3-0 rate selection output  frequency and int. rateπ        0B    status register Bπ               bit 7 = 0  runπ                 = 1  haltπ               bit 6 = 1  enable periodic interruptπ               bit 5 = 1  enable alarm interruptπ               bit 4 = 1  enable update-ended interruptπ               bit 3 = 1  enable square wave interruptπ               bit 2 = 1  calendar is in binary formatπ                 = 0  calendar is in BCD formatπ               bit 1 = 1  24-hour modeπ                 = 0  12-hour modeπ               bit 0 = 1  enable daylight savings time. only in USA.π                  useless in Europe. Some DOS versions clearπ                  this bit when you use the DAT/TIME command.π        0C    status register Cπ               bit 7 =      interrupt request flagπ               bit 6 =      peridoc interrupt flagπ               bit 5 =      alarm interrupt flagπ               bit 4 =      update interrupt flagπ               bit 3-0      reservedπ        0D    status register Dπ               bit 7 = 1  Real-Time Clock has powerπ               bit 6-0      reservedπ        0E    diagnostics status byteπ               bit 7 = 0  RTC lost powerπ               bit 6 = 1  CMOS RAM checksum badπ               bit 5 = 1  invalid configuration information at POSTπ               bit 4 = 1  memory size error at POSTπ               bit 3 = 1  fixed disk/adapter failed initializationπ               bit 2 = 1  CMOS RAM time found invalidπ               bit 1 = 1  adapters do not match configuration (EISA)π               bit 0 = 1  time out reading an adapter ID (EISA)π        0F    shutdown status byteπ               00 = normal execution of POSTπ               01 = chip set initialization for real mode reentryπ               04 = jump to bootstrap codeπ               05 = issue an EOI an JMP to Dword ptr at 40:67π               06 = JMP to Dword ptrv at 40:67 without EOIπ               07 = return to INT15/87 (block move)π               08 = return to POST memory testπ               09 = return to INT15/87 (block move)π               0A = JMP to Dword ptr at 40:67 without EOIπ               0B = return IRETS through 40:67π        10    diskette drive type for A: and B:π               bit 7-4    drive type of drive 0π               bit 3-0    drive type of drive 1π                   = 0000       no driveπ                   = 0001       360Kπ                   = 0010       1M2π                   = 0011       720Kπ                   = 0100       1M44π                   = 0101-1111 reservedπ        11    reserved / AMI Extended CMOS setup (AMI Hi-Flex BIOS)π               bit 7   = 1     Typematic Rate Programmingπ               bit 6-5 = 00    Typematic Rate Delay 250 mSecπ               bit 4-0 = 00011 Typematic Rate 21.8 Chars/Secπ        12    fixed disk drive type for drive 0 and drive 1π               bit 7-4    drive type of drive 0π               bit 3-0    drive type of drive 1π                if either of the nibbles equals 0F, then bytesπ                19 an 1A are validπ        13    reserved / AMI Extended CMOS setup (AMI Hi-Flex BIOS)π               bit 7 = 1  Mouse Support Optionπ               bit 6 = 1  Above 1 MB Memory Test disableπ               bit 5 = 1  Memory Test Tick Sound disableπ               bit 4 = 1  Memory Parity Error Check enableπ               bit 3 = 1  Hit <ESC> Message Display disabledπ               bit 2 = 1  Hard Disk Type 47 Data Area at address 0:300π               bit 1 = 1  Wait For <F1> If Any Error enabledπ               bit 0 = 1  System Boot Up Num Lock is Onπ        14    equipment byteπ               bit 7-6     diskette drives installedπ                   = 00  1 drive installedπ                   = 01  2 drives installedπ                   = 10  reservedπ                   = 11  reservedπ               bit 5-4     primary displayπ                   = 00  adapter card with option ROM π                   = 01  40*25 colorπ                   = 10  80*25 colorπ                   = 11  monochromeπ               bit 3-2     reservedπ               bit 1   = 1  coprocessor installed (non-Weitek)π               bit 0        diskette drive avaliable for bootπ        15    LSB of systemn base memory in Kbπ        16    MSB of systemn base memory in Kbπ        17    LSB of total extended memory in Kbπ        18    MSB of total extended memory in Kbπ        19    drive C extension byteπ        1A    drive D extension byteπ        1B-27 reservedπ        1B/1C word to 82335 RC1 roll compare register at [24]π            (Phoenix)π        1D/1E word to 82335 RC2 roll compare register at [26]π            (Phoenix)π        28    HP-Vectra checksum over 29-2Dπ        29-2D reservedπ        29/2A word to Intel 82335 CC0 compare register atπ            [28](Phoenix)π        2B/2C word send to 82335 CC1 compare register at [2A]π            (Phoenix)π        2D    AMI Extended CMOS setup (AMI Hi-Flex BIOS)π              (Phoenix BIOS checks for the values AA or CC)π               bit 7 = 1  Weitek Processor Absentπ               bit 6 = 1  Floppy Drive Seek At Boot disabledπ               bit 5 = 1  System Boot Up Sequence  C:, A:π               bit 4 = 1  System Boot Up Speed is highπ               bit 3 = 1  Cache Memory enabledπ               bit 2 = 1  Internal Cache Memory     <1>π               bit 1-0      reservedπ        2E    CMOS MSB checksum over 10-2Dπ        2F    CMOS LSB checksum over 10-2Dπ        30    LSB of extended memory found above 1Mb at POSTπ        31    MSB of extended memory found above 1Mb at POSTπ        32    date century in BCDπ        33    information flagsπ               bit4 = bit4 from CPU register CR0   (Phoenix)π                  this bit is only known as INTEL RESERVEDπ        34-3F reserved    π        34     bit4 bit5 (Phoenix BIOS)π        3D/3E word to 82335 MCR memory config register atπ            [22](Phoenix)π        3D     bit3     base memsize 512/640  (Phoenix)π        3E     bit7 = 1     relocate enable       (Phoenix)π               bit1 = 1     shadow video enable   (Phoenix)π               bit0 = 1     shadow BIOS enable    (Phoenix)πππ        User Definable Drive Parameters are also stored in CMOS RAM:ππ        AMI (386sx BIOS 1989) first user definable drive (type 47)π         1B  L cylindersπ         1C  H cylindersπ         1D  headsπ         1E  L Write Precompensation Cylinderπ         1F  H Write Precompensation Cylinderπ         20  ??π         21  L cylinders parking zoneπ         22  H cylinders parking zoneπ         23  sectorsππ        AMI (386sx BIOS 1989) second user definable drive (type 48)π         24  L cylindersπ         25  H cylindersπ         26  headsπ         27  L Write Precompensation Cylinderπ         28  H Write Precompensation Cylinderπ         29  ??π         2A  L cylinders parking zoneπ         2B  H cylinders parking zoneπ         2C  sectorsππ        Phoenix (386BIOS v1.10.03 1988) 1st user definable drv (type48)π         20  L cylindersπ         21  H cylindersπ         22  headsπ         23  L Write Precompensation Cylinderπ         24  H Write Precompensation Cylinderπ         25  L cylinders parking zoneπ         26  H cylinders parking zoneπ         27  sectorsππ        Phoenix (386BIOS v1.10.03 1988) 2nd user definable drv (type49)π        (when PS/2-style password option is not used)π         35  L cylindersπ         36  H cylindersπ         37  headsπ         38  L Write Precompensation Cylinderπ         39  H Write Precompensation Cylinderπ         3A  L cylinders parking zoneπ         3B  H cylinders parking zoneπ         3C  sectorsππ0078        HP-Vectra  Hard Reset: NMI enable/disableπ         bit 7 = 0  disable & clear hard reset from HP-HIL controllerπ               = 1  enable hard reset from HP-HIL controller chipπ         bit 6-0    reservedππ-------------------------------------------------------------------------------π0078-007F ----    PC radio by CoZet Info Systemsπ        The I/O address range is dipswitch selectable from:π           038-03F and 0B0-0BFπ           078-07F and 0F9-0FFπ           138-13F and 1B0-1BFπ           178-17F and 1F9-1FFπ           238-23F and 2B0-2BFπ           278-27F and 2F0-2FFπ           338-33F and 3B0-3BFπ           378-37F and 3F0-3FFπ        All of these addresses show a readout of FF in initial state.π        Once started, all of the addresses show     FB, whatever mightπ        happen.ππ-------------------------------------------------------------------------------π007C-007D ----    HP-Vectra  PIC 3   (Programmable Interrupt Controller 8259)π        cascaded to first controller.π        used for keyboard and input device interface.π007C    r/w    HP-Vectra  PIC 3  see at 0020  PIC 1π007D    r/w    HP-Vectra  PIC 3  see at 0021  PIC 1ππ-------------------------------------------------------------------------------π0080    w    Manufacturing Diagnostics portππ-------------------------------------------------------------------------------π0080-008F ----    DMA page registers   (74612)ππ0080    r/w    extra page register (temporary storage)π0081    r/w    DMA channel 2 address byte 2π0082    r/w    DMA channel 3 address byte 2π0083    r/w    DMA channel 1 address byte 2π0084    r/w    extra page registerπ0085    r/w    extra page registerπ0086    r/w    extra page registerπ0087    r/w    DMA channel 0 address byte 2π0088    r/w    extra page registerπ0089    r/w    DMA channel 6 address byte 2π0089    r/w    DMA channel 7 address byte 2π0089    r/w    DMA channel 5 address byte 2π008C    r/w    extra page registerπ008D    r/w    extra page registerπ008E    r/w    extra page registerπ008F    r/w    DMA refresh page registerππ-------------------------------------------------------------------------------π0090-009F ----    PS/2 POS (Programmable Option Select)ππ0090        Central arbitration control portπ0091        Card selection feedbackππ0092    r/w    PS/2 system control port A  (port B is at 0061)π         bit 7-6   any bit set to 1 turns activity light onπ         bit 5       reservedπ         bit 4 = 1 watchdog timout occurred π         bit 3 = 0 RTC/CMOS security lock (on password area) unlockedπ               = 1 CMOS locked (done by POST)π         bit 2       reservedπ         bit 1 = 1 indicates A20 activeπ         bit 0 = 0 system reset or writeπ             1 pulse alternate reset pin (alternate CPU reset)ππ0094    w    system board enable/setup registerπ         bit 7 = 1  enable functionsπ               = 0  setup functionsπ         bit 5 = 1  enables VGAπ               = 0  setup VGAππ0095        reservedππ0096    w    adapter enable /setup registerπ         bit 3 = 1  setup adaptersπ               = 0  enable registersππ0097        reservedππ-------------------------------------------------------------------------------π00A0-00AF ----    PIC 2    (Programmable Interrupt Controller 8259)ππ00A0    r/w    NMI mask register (XT)ππ00A0    r/w    PIC 2  same as 0020 for PIC 1π00A1    r/w    PIC 2  same as 0021 for PIC 1 except for OCW1:π         bit 7 = 0  reservedπ         bit 6 = 0  enable fixed disk interruptπ         bit 5 = 0  enable coprocessor exception interruptπ         bit 4 = 0  enable mouse interruptπ         bit 3 = 0  reservedπ         bit 2 = 0  reservedπ         bit 1 = 0  enable redirect cascadeπ         bit 0 = 0  enable real-time clock interruptππ-------------------------------------------------------------------------------π00B0-00BF ----    PC radio by CoZet Info Systemsπ        The I/O address range is dipswitch selectable from:π           038-03F and 0B0-0BFπ           078-07F and 0F9-0FFπ           138-13F and 1B0-1BFπ           178-17F and 1F9-1FFπ           238-23F and 2B0-2BFπ           278-27F and 2F0-2FFπ           338-33F and 3B0-3BFπ           378-37F and 3F0-3FFπ        All of these addresses show a readout of FF in initial state.π        Once started, all of the addresses show     FB, whatever mightπ        happen.ππ-------------------------------------------------------------------------------π00C0      ----    TI  SN746496 programmable tone/noise generator    PCjrππ-------------------------------------------------------------------------------π00C0-00DF ----    DMA 2    (second Direct Memory Access controller 8237)ππ00C0    r/w    DMA channel 4 memory address bytes 1 and 0 (low) (ISA, EISA)π00C2    r/w    DMA channel 4 transfer count bytes 1 and 0 (low) (ISA, EISA)π00C4    r/w    DMA channel 5 memory address bytes 1 and 0 (low) (ISA, EISA)π00C6    r/w    DMA channel 5 transfer count bytes 1 and 0 (low) (ISA, EISA)π00C8    r/w    DMA channel 6 memory address bytes 1 and 0 (low) (ISA, EISA)π00CA    r/w    DMA channel 6 transfer count bytes 1 and 0 (low) (ISA, EISA)π00CC    r/w    DMA channel 7 memory address byte 0 (low), then 1 (ISA, EISA)π00CE    r/w    DMA channel 7 transfer count byte 0 (low), then 1 (ISA, EISA)ππ00D0    r    DMA channel 4-7 status register (ISA, EISA)π         bit 7 = 1  channel 7 requestπ         bit 6 = 1  channel 6 requestπ         bit 5 = 1  channel 5 requestπ         bit 4 = 1  channel 4 requestπ         bit 3 = 1  terminal count on channel 7π         bit 2 = 1  terminal count on channel 6π         bit 1 = 1  terminal count on channel 5π         bit 0 = 1  terminal count on channel 4ππ00D0    w    DMA channel 4-7 command register (ISA, EISA)π         bit 7 = 1  DACK sense active highπ               = 0  DACK sense active lowπ         bit 6 = 1  DREQ sense active highπ               = 0  DREQ sense active lowπ         bit 5 = 1  extended write selectionπ               = 0  late write selectionπ         bit 4 = 1  rotating priorityπ               = 0  fixed priorityπ         bit 3 = 1  compressed timingπ               = 0  normal timingπ         bit 2 = 0  enable controllerπ         bit 1 = 1  enable memory-to-memory transferπ         bit 0        .....ππ00D2    w    DMA channel 4-7 write request register (ISA, EISA)ππ00D4    w    DMA channel 4-7 write single mask register (ISA, EISA)π         bit 7-3      reservedπ         bit 2     = 0  clear mask bitπ             = 1  set mask bitπ         bit 1-0 = 00 channel 4 selectπ             = 01 channel 5 selectπ             = 10 channel 6 selectπ             = 11 channel 7 selectππ00D6    w    DMA channel 4-7 mode register (ISA, EISA)π         bit 7-6 = 00  demand modeπ             = 01  single modeπ             = 10  block modeπ             = 11  cascade modeπ         bit 5     = 0   address increment selectπ             = 1   address decrement selectπ         bit 4     = 0   autoinitialisation disableπ             = 1   autoinitialisation enableπ         bit 3-2 = 00  verify operationπ             = 01  write to memoryπ             = 10  read from memoryπ             = 11  reservedπ         bit 1-0 = 00  channel 4 selectπ             = 01  channel 5 selectπ             = 10  channel 6 selectπ             = 11  channel 7 selectππ00D8    w    DMA channel 4-7 clear byte pointer flip-flop (ISA, EISA)π00DA    r    DMA channel 4-7 read temporary register (ISA, EISA)π00DA    w    DMA channel 4-7 master clear (ISA, EISA)π00DC    w    DMA channel 4-7 clear mask register (ISA, EISA)π00DE    w    DMA channel 4-7 write mask register (ISA, EISA)ππ00E0        split address register, memory encoding registers PS/2m80 onlyππ-------------------------------------------------------------------------------π00F0-00F5 ----    PCjr Disk Controllerππ00F0        disk controllerπ00F2        disk controller control portπ00F4        disk controller status registerπ00F5        disk controller data portππ-------------------------------------------------------------------------------π00F0-00FF ----    coprocessor (8087..80387)ππ00F0        math coprocessor clear busy latchπ00F1        math coprocessor resetπ00F8-00FF    math coprocessorππ-------------------------------------------------------------------------------π00F9-00FF ----    PC radio by CoZet Info Systemsπ        The I/O address range is dipswitch selectable from:π           038-03F and 0B0-0BFπ           078-07F and 0F9-0FFπ           138-13F and 1B0-1BFπ           178-17F and 1F9-1FFπ           238-23F and 2B0-2BFπ           278-27F and 2F0-2FFπ           338-33F and 3B0-3BFπ           378-37F and 3F0-3FFπ        All of these addresses show a readout of FF in initial state.π        Once started, all of the addresses show     FB, whatever mightπ        happen.ππ-------------------------------------------------------------------------------π0100-010F ----    CompaQ Tape drive adapter. alternate address at 0300ππ-------------------------------------------------------------------------------π0100-0107 ----    PS/2 POS (Programmable Option Select)ππ0100    r    POS register 0    Low adapter ID byteπ0101    r    POS register 1    High adapter ID byteππ0102    r/w    POS register 2    option select data byte 1π         bit 0 is card enable (CDEN)ππ0103    r/w    POS register 3    option select data byte 2π0104    r/w    POS register 4    option select data byte 3π0105    r/w    POS register 5    option select data byte 4π         bit 7    channel active (-CHCK)π         bit 6    channel statusππ0106    r/w    POS register 6    Low subaddress extensionπ0107    r/w    POS register 7    High subaddress extensionππ-------------------------------------------------------------------------------π0108-010F ----    8 digit LED info panel on IBM PS/2ππ010F    w    leftmost character on displayπ010E    w    second characterπ....    wπ0108    w    eighth characterππ-------------------------------------------------------------------------------π0130-013F ----    CompaQ SCSI adapter. alternate address at 0330ππ-------------------------------------------------------------------------------π0130-0133 ----    Adaptec 154xB/154xC SCSI adapter.π        alternate address at 0134, 0230, 0234 ,0330 and 0334ππ-------------------------------------------------------------------------------π0134-0137 ----    Adaptec 154xB/154xC SCSI adapter.π        alternate address at 0130, 0230, 0234 ,0330 and 0334ππ-------------------------------------------------------------------------------π0138-013F ----    PC radio by CoZet Info Systemsπ        The I/O address range is dipswitch selectable from:π           038-03F and 0B0-0BFπ           078-07F and 0F9-0FFπ           138-13F and 1B0-1BFπ           178-17F and 1F9-1FFπ           238-23F and 2B0-2BFπ           278-27F and 2F0-2FFπ           338-33F and 3B0-3BFπ           378-37F and 3F0-3FFπ        All of these addresses show a readout of FF in initial state.π        Once started, all of the addresses show     FB, whatever mightπ        happen.ππ-------------------------------------------------------------------------------π0140-014F ----    SCSI (alternate Small Computer System Interface) adapterπ        (1st at 0340-034F)ππ-------------------------------------------------------------------------------π0140-0157 ----    RTC (alternate Real Time Clock for XT)     (1st at 0340-0357)ππ-------------------------------------------------------------------------------π0170-0177 ----    HDC 2    (2nd Fixed Disk Controller)   same as 01Fx (ISA, EISA)ππ-------------------------------------------------------------------------------π0178-017F ----    PC radio by CoZet Info Systemsπ        The I/O address range is dipswitch selectable from:π           038-03F and 0B0-0BFπ           078-07F and 0F9-0FFπ           138-13F and 1B0-1BFπ           178-17F and 1F9-1FFπ           238-23F and 2B0-2BFπ           278-27F and 2F0-2FFπ           338-33F and 3B0-3BFπ           378-37F and 3F0-3FFπ        All of these addresses show a readout of FF in initial state.π        Once started, all of the addresses show     FB, whatever mightπ        happen.ππ-------------------------------------------------------------------------------π01E8-01EF ----    System Control. Laptop chipset: Headland HL21 & Acer M5105ππ01ED    r/w    select internal register. Data to/from 01EFπ01EE    rπ01EF    r/w    reg.π        5  = 1000xxxx  for low CPU clock speed (4MHz on Morse/Mitac)π           = 0xxxxxxx  for high CPU clock speed (16MHz on Morse/Mitac)ππ-------------------------------------------------------------------------------π01F0-01F7 ----    HDC 1    (1st Fixed Disk Controller)   same as 017x (ISA, EISA)ππ01F0    r/w    data registerππ01F1    r    error registerπ        diagnostic mode errors:π         bit 7-3    reservedπ         bit 2-1 = 001    no error detectedπ             = 010    formatter device errorπ             = 011    sector buffer errorπ             = 100    ECC circuitry errorπ             = 101    controlling microprocessor errorπ         operation mode:π          bit 7     = 1  bad block detectedπ             = 0  block OKπ          bit 6     = 1  uncorrectable ECC errorπ             = 0  no errorπ          bit 5          reservedπ          bit 4     = 1  ID foundπ             = 0  ID not foundπ          bit 3          reservedπ          bit 2     = 1  command completedπ             = 0  command abortedπ          bit 1     = 1  track 000 not foundπ             = 0  track 000 foundπ          bit 0     = 1  DAM not foundπ             = 0  DAM found (CP-3022 always 0)ππ01F1    w    WPC/4  (Write Precompensation Cylinder divided by 4)ππ01F2    r/w    sector countπ01F3    r/w    sector numberπ01F4    r/w    cylinder lowπ01F5    r/w    cylinder highππ01F6    r/w    drive/headπ         bit 7     = 1π         bit 6     = 0π         bit 5     = 1π         bit 4     = 0  drive 0 selectπ             = 1  drive 1 selectπ         bit 3-0      head select bitsππ01F7    r    status registerπ         bit 7 = 1  controller is executing a commandπ         bit 6 = 1  drive is readyπ         bit 5 = 1  write faultπ         bit 4 = 1  seek completeπ         bit 3 = 1  sector buffer requires servicingπ         bit 2 = 1  disk data read successfully correctedπ         bit 1 = 1  index - set to 1 each disk revolutionπ         bit 0 = 1  previous command ended in an errorππ01F7    w    command registerπ        commands:π         98 E5     check power mode    (IDE)π         90     execute drive diagnosticsπ         50     format trackπ         EC     identify drive        (IDE)π         97 E3     idle            (IDE)π         95 E1     idle immediatete    (IDE)π         91     initialize drive parametersπ         1x     recalibrateπ         E4     read buffer        (IDE)π         C8     read DMA with retry    (IDE)π         C9     read DMA without retry (IDE)π         C4     read multiplec        (IDE)π         20     read sectors with retryπ         21     read sectors without retryπ         22     read long with retryπ         23     read long without retryπ         40     read verify sectors with retryπ         41     read verify sectors without retryπ         7x     seekπ         EF     set features        (IDE)π         C6     set multiple mode    (IDE)π         99 E6     set sleep mode        (IDE)π         96 E2     standby        (IDE)π         94 E0     standby immediate    (IDE)π         E8     write buffer        (IDE)π         CA     write DMA with retry    (IDE)π         CB     write DMA with retry    (IDE)π         C5     write multiple        (IDE)π         E9     write same        (IDE)π         30     write sectors with retryπ         31     write sectors without retryπ         32     write long with retryπ         33     write long without retryπ         3C     write verify        (IDE)π         9A     vendor unique        (IDE)π         C0-C3     vendor unique        (IDE)π         8x     vendor unique        (IDE)π         F0-F4     EATA standard        (IDE)π         F5-FF     vendor unique        (IDE)ππ-------------------------------------------------------------------------------π01F9-01FF ----    PC radio by CoZet Info Systemsπ        The I/O address range is dipswitch selectable from:π           038-03F and 0B0-0BFπ           078-07F and 0F9-0FFπ           138-13F and 1B0-1BFπ           178-17F and 1F9-1FFπ           238-23F and 2B0-2BFπ           278-27F and 2F0-2FFπ           338-33F and 3B0-3BFπ           378-37F and 3F0-3FFπ        All of these addresses show a readout of FF in initial state.π        Once started, all of the addresses show     FB, whatever mightπ        happen.ππ-------------------------------------------------------------------------------π0200-020F ----    Game port reserved I/O address space  π0200-0207 ----    Game port, eight identical addresses on some boardsππ0201    r    read joystick position and statusπ         bit 7    status B joystick button 2 / D paddle buttonπ         bit 6    status B joystick button 1 / C paddle buttonπ         bit 5    status A joystick button 2 / B paddle buttonπ         bit 4    status A joystick button 1 / A paddle buttonπ         bit 3    B joystick Y coordinate       / D paddle coordinateπ         bit 2    B joystick X coordinate       / C paddle coordinateπ         bit 1    A joystick Y coordinate       / B paddle coordinateπ         bit 0    A joystick X coordinate       / A paddle coordinateππ    w    fire joysticks four one-shotsππ-------------------------------------------------------------------------------π0210-0217 ----    Expansion unit (XT)ππ0210    w    latch expansion bus dataπ    r    verify expansion bus dataπ0211    w    clear wait, test latchπ    r    High byte data addressπ0212    r    Low byte data addressπ0213    w    0=enable,  1=disable expansion unitπ0214    w    latch data  (receiver card port)π    r    read data   (receiver card port)π0215    r    High byte of address, then Low byte   (receiver card port)ππ-------------------------------------------------------------------------------π0220-0227 ----    Soundblaster PRO and SSB 16 ASPππ-------------------------------------------------------------------------------π0220-022F ----    Soundblaster PRO 2.0ππ-------------------------------------------------------------------------------π0220-022F ----    Soundblaster PRO 4.0π0220    r    left FM status portπ0220    w    left FM music register address port (index)π0221    r/w    left FM music data portπ0222    r    right FM status portπ0222    w    right FM music register address port (index)π0223    r/w    right FM music data portπ0224    w    mixer register address port (index)π0225    r/w    mixer data portπ0226    w    DSP resetπ0228    r    FM music status portπ0228    w    FM music register address port (index)π0229    w    FM music data portπ022A    r    DSP read data (voice I/O and Midi)π022C    w    DSP write data / write commandπ022C    r    DSP write buffer status (bit 7)π022E    r    DSP data available status (bit 7)ππ        The FM music is accessible on 0388/0389 for compatibility.ππ-------------------------------------------------------------------------------π0230-0233 ----    Adaptec 154xB/154xC SCSI adapter.π        alternate address at 0130, 0134, 0230, 0330 and 0334ππ-------------------------------------------------------------------------------π0234-0237 ----    Adaptec 154xB/154xC SCSI adapter.π        alternate address at 0130, 0134, 0230 ,0330 and 0334ππ-------------------------------------------------------------------------------π0240-0257 ----    RTC (alternate Real Time Clock for XT)     (1st at 0340-0357)π        (used by TIMER.COM v1.2 which is the 'standard' timer program)ππ-------------------------------------------------------------------------------π0258-025F ----    Intel Above Boardππ-------------------------------------------------------------------------------π0278-027E ----    parallel printer port, same as 0378 and 03BCππ0278    w    data portπ0279    r/w    status portπ027A    r/w    control portππ-------------------------------------------------------------------------------π02A2-02A3 ----    MSM58321RS clockππ-------------------------------------------------------------------------------π02B0-02BF ----    Trantor SCSI adapterππ-------------------------------------------------------------------------------π02B0-02DF ----    alternate EGA,    primary EGA at 03C0ππ-------------------------------------------------------------------------------π02C0-02Cx ----    AST-clockππ-------------------------------------------------------------------------------π02E0-02EF ----    GPIB (General Purpose Interface Bus, IEEE 488 interface)π        (GAB 0 on XT)π02E1        GPIB (adapter 0)π02E2π02E3ππ-------------------------------------------------------------------------------π02E0-02EF ----    data aquisition     (AT)ππ02E2        data aquisition (adapter 0)π02E3        data aquisition (adapter 0)ππ-------------------------------------------------------------------------------π02E8-02EF ----    serial port, same as 02F8, 03E8, and 03F8ππ-------------------------------------------------------------------------------π02F8-02FF ----    serial port, same as 02E8, 02F8, and 03F8ππ02F8    w    transmitter holding registerπ02F8    r    receiver buffer registerπ    r/w    divisor latch, low byte      when DLAB=1π02F9    r/w    divisor latch, high byte  when DLAB=1π    r/w    interrupt enable register when DLAB=0π02FA    r    interrupt identification registerπ02FB    r/w    line control registerπ02FC    r/w    modem control registerπ02FD    r    line status registerπ02FF    r/w    scratch registerππ-------------------------------------------------------------------------------π0300-0301 ---- Soundblaster 16 ASP MPU-Midiππ-------------------------------------------------------------------------------π0300-031F ----    prototype cardsπ        Periscope hardware debuggerππ-------------------------------------------------------------------------------π0300-030F ----    Philips CD-ROM player CM50π0310-031F ----    Philips CD-ROM player CM50ππ-------------------------------------------------------------------------------π0320-0323 ----    XT HDC 1   (Hard Disk Controller)ππ0320    r/w    data registerππ0321    w    reset controllerπ    r    read controller hardware statusπ         bit 7-6 = 0π         bit 5          logical unit numberπ         bit 4-2 = 0π         bit 1     = 0  no errorπ         bit 0     = 0 ππ0322    r    read DIPswitch setting on XT controller cardπ    w    generate controller-select pulseπ0323    w    write pattern to DMA and INT mask registerππ0324-0327 ----    XT HDC 2   (Hard Disk Controller)π0328-032B ----    XT HDC 3   (Hard Disk Controller)π032C-032F ----    XT HDC 4   (Hard Disk Controller)ππ-------------------------------------------------------------------------------π0330-0331 ----    MIDI interfaceππ-------------------------------------------------------------------------------π0330-0333 ----    Adaptec 154xB/154xC SCSI adapter. default address.π        alternate address at 0130, 0134, 0230, 0234 and 0334ππ-------------------------------------------------------------------------------π0330-033F ----    CompaQ SCSI adapter. alternate address at 0130ππ-------------------------------------------------------------------------------π0330-033F ----    Philips CD-ROM player CM50ππ-------------------------------------------------------------------------------π0334-0337 ----    Adaptec 154xB/154xC SCSI adapter.π        alternate address at 0130, 0134, 0230 ,0234 and 0330ππ-------------------------------------------------------------------------------π0338      ----    AdLib soundblaster cardππ-------------------------------------------------------------------------------π0340-034F ----    Philips CD-ROM player CM50ππ-------------------------------------------------------------------------------π0340-034F ----    SCSI (1st Small Computer System Interface) adapterπ        (alternate at 0140-014F)ππ-------------------------------------------------------------------------------π0340-0357 ----    RTC (1st Real Time Clock for XT), (alternate at 0240-0257)π        (used by TIMER.COM v1.2 which is the 'standard' timer program)ππ0340    r/w    0.01 seconds  0-99π0341    r/w    0.1 seconds   0-99π0342    r/w    seconds          0-59π0343    r/w    minutes          0-59π0343    r/w    hours          0-23π0345    r/w    day of week   1-7π0346    r/w    day of month  1-31π0347    r/w    month          1-12π0348π0349    r/w    year          0-99π034Aπ034Bπ034Cπ034Dπ034Eπ034Fπ0350    r    status?π0351    π0352π0353π0354    r    status?π0355π0356π0357ππ-------------------------------------------------------------------------------π0348-0357 ----    DCA 3278ππ-------------------------------------------------------------------------------π0360-036F ----    PC network (AT)π0360-0367 ----    PC network (XT only)ππ-------------------------------------------------------------------------------π0370-0377 ----    FDC 2  (2nd Floppy Disk Controller 8272)  same as 03F0ππ0372    w    diskette controller DOR (Digital Output Register)π0374    r    diskette controller status registerπ0375    r/w    diskette controller data registerπ0376    r/w    FIXED disk controller data registerπ0377    r    diskette controller DIR (Digital Input Register)π0377    w    select register for diskette data transfer rateππ-------------------------------------------------------------------------------π0378-037A ----    parallel printer port, same as 0278 and 03BCππ0378    w    data portπ0379    r/w    status portπ037A    r/w    control portππ-------------------------------------------------------------------------------π0380-038F ----    2nd Binary Synchronous Data Link Control adapter (see 03A0)ππ0380    r/w     on board 8255 port A, internal/external senseπ0381    r/w     on board 8255 port B, external modem interfaceπ0382    r/w     on board 8255 port C, internal control and gatingπ0383    r/w     on board 8255 mode registerπ0384    r/w     on board 8253 channel square wave generatorπ0385    r/w     on board 8253 channel 1 inactivity time-outπ0386    r/w     on board 8253 channel 2 inactivity time-outπ0387    r/w     on board 8253 mode registerπ0388    r/w     on board 8273 read: status  write: commandπ0389    r/w     on board 8273 read: response  write: parameterπ038A    r/w     on board 8273 transmit interrupt statusπ038B    r/w     on board 8273 receiver interrupt statusπ038C    r/w     on board 8273 dataππ-------------------------------------------------------------------------------π0388-0389 ---- Soundblaster PRO FM-Chipπ0388-038B ---- Soundblaster 16 ASP FM-Chipππ-------------------------------------------------------------------------------π0390-039F ----    Cluster adapter (AT)ππ0390-0393    (adapter 0)    (XT)ππ-------------------------------------------------------------------------------π03A0-03AF ----    1st SDLC (Binary Synchronous Data Link Control adapter)ππ0380    r/w     on board 8255 port A, internal/external senseπ0381    r/w     on board 8255 port B, external modem interfaceπ0382    r/w     on board 8255 port C, internal control and gatingπ0383    r/w     on board 8255 mode registerπ0384    r/w     on board 8253 counter 0 unusedπ0385    r/w     on board 8253 channel 1 inactivity time-outπ0386    r/w     on board 8253 channel 2 inactivity time-outπ0387    r/w     on board 8253 mode registerπ0388    r/w     on board 8251 dataπ0389    r/w     on board 8251 command/mode/status registerππ-------------------------------------------------------------------------------π03B0-03BF ----    MDA  (Monochrome Display Adapter based on 6845)ππ03B0        same as 03B4π03B1        same as 03B5π03B2        same as 03B4π03B3        same as 03B5π03B4    w    MDA CRT index register     (EGA/VGA)π        selects which register (0-11h) is to be accessed through 3B5π03B5    r/w    MDA CRT data register     (EGA/VGA)π        selected by port 3B4. registers C-F may be readπ         00  horizontal totalπ         01  horizontal displayedπ         02  horizontal sync positionπ         03  horizontal sync pulse widthπ         04  vertical totalπ         05  vertical displayedπ         06  vertical sync positionπ         07  vertical sunc pulse widthπ         08  interlace modeπ         09  maximum scan linesπ         0A  cursor startπ         0B  cursor endπ         0C  start address highπ         0D  start address lowπ         0E  cursor location highπ         0F  cursor location lowπ         10  light pen highπ         11  light pen lowπ03B6        same as 03B4π03B7        same as 03B5π03B8    r/w    MDA mode control registerπ         bit 7 not usedπ         bit 6 not usedπ         bit 5 enable blinkπ         bit 4 not usedπ         bit 3 video enableπ         bit 2 not usedπ         bit 1 not usedπ         bit 0 high resolution modeππ03B9        reserved for color select register on color adapterππ03BA    r    CRT status register     EGA/VGA: input status 1 registerπ         bit 7-4 reservedπ         bit 3     black/white videoπ         bit 2-1 reservedπ         bit 0     horizontal driveππ         bit 7     (MSD says) if this bit changes within 8000h reads thenπ          bit 6-4 = 000 = adapter is Hercules or compatibleπ                001 = adapter is Hercules+π                101 = adapter is Hercules InColorπ                  else: adapter is unknownππ03BA    w    EGA/VGA feature control registerππ03BB        reserved for light pen strobe resetππ-------------------------------------------------------------------------------π03BC-03BF ----    parallel printer port, same as 0278 and 0378ππ03BC    w    data portπ03BD    r/w    status portπ         bit 7 = 0  busyπ         bit 6 = 0  acknowledgeπ         bit 5 = 1  out of paperπ         bit 4 = 1  printer is selectedπ         bit 3 = 0  errorπ         bit 2 = 0  IRQ has occurredπ         bit 1-0    reservedππ03BE    r/w    control portπ         bit 7-5    reservedπ         bit 4 = 1  enable IRQπ         bit 3 = 1  select printerπ         bit 2 = 0  initialize printerπ         bit 1 = 1  automatic line feedπ         bit 0 = 1  strobeππ-------------------------------------------------------------------------------π03BF    r/w    Hercules configuration switch registerπ         bit 7-2π         bit 1 = 0  disables upper 32K of graphics mode bufferπ             1  enables upper 32K of graphics mode bufferπ         bit 0 = 0  prevents graphics modeπ             1  allows graphics modeππ-------------------------------------------------------------------------------π03C0-03CF ----    EGA  (1st Enhanced Graphics Adapter)    alternate at 02C0ππ03C0    (r)/w    EGA VGA ATC index/data registerπ03C1    r    VGA    other attribute registerπ03C2    r    EGA VGA input status 0 registerπ    w    VGA    miscellaneous output registerπ03C3    r/w    VGA    video subsystem enableπ03C4    w    EGA    TS index registerπ    r/w    VGA    sequencer index registerπ03C5    w    EGA    TS data registerπ    r/w    VGA    other sequencer registerπ03C6    r/w    VGA    PEL mask registerπ03C7    r/w    VGA    PEL address read modeπ    r    VGA    DAC state registerπ03C8    r/w    VGA    PEL address write modeπ03C9    r/w    VGA    PEL data registerπ03CA    w    EGA    graphics 2 position registerπ    r    VGA    feature control registerπ03CC    w    EGA    graphics 1 position registerπ    r    VGA    miscellaneous output registerπ03CE    w    EGA    GDC index registerπ    r/w    VGA    graphics address registerπ03CF    w    EGA    GDC data registerπ    r/w    VGA    other graphics registerππ-------------------------------------------------------------------------------π03D0-03DF ----    CGA   (Color Graphics Adapter)ππ03D0        same as 03D4π03D1        same as 03D5π03D2        same as 03D4π03D3        same as 03D5π03D4    w    CRT (6845) index register   (EGA/VGA)π        selects which register (0-11h) is to be accessed through 3B5π03D5    w    CRT (6845) data register    (EGA/VGA)π        selected by port 3B4. registers C-F may be readπ         (for registers see at 3B5)π03D6        same as 03D4π03D7        same as 03D5π03D8    r/w    CGA mode control register  (except PCjr)π         bit 7-6      not usedπ         bit 5     = 1  blink enabledπ         bit 4     = 1  640*200 graphics modeπ         bit 3     = 1  video enabledπ         bit 2     = 1  monochrome signalπ         bit 1     = 0  text modeπ             = 1  320*200 graphics modeπ         bit 0     = 0  40*25 text modeπ             = 1  80*25 text modeππ03D9    r/w    CGA palette registerπ         bit 7-6      not usedπ         bit 5     = 0 active color set: red, green brownπ             = 1 active color set: cyan, magenta, whiteπ         bit 4         intense colors in graphics, background colors textπ         bit 3         intense border in 40*25, intense background inπ                 320*200, intense foreground in 640*200π         bit 2         red border in 40*25, red background in 320*200,π                 red foreground in 640*200π         bit 1         green border in 40*25, green background inπ                 320*200, green foreground in 640*200π         bit 0         blue border in 40*25, blue background in 320*200,π                 blue foreground in 640*200ππ03DA    r    CGA status register    EGA/VGA: input status 1 registerπ         bit 7-4     not usedπ         bit 3 = 1   in vertical retraceπ         bit 2 = 1   light pen switch is offπ         bit 1 = 1   positive edge from light pen has set triggerπ         bit 0 = 0   do not use memoryπ               = 1   memory access without interfering with displayππ03DA    w    EGA/VGA feature control registerππ03DB    w    clear light pen latchπ03DC    r/w    preset licht pen latchππ03DF        CRT/CPU page register  PCjr onlyππ-------------------------------------------------------------------------------π03E8-03EF ----    serial port, same as 02E8, 02F8, and 03F8ππ-------------------------------------------------------------------------------π03F0-03F7 ----    FDC 1  (1st Floppy Disk Controller 8272)  same as 0370ππ03F0        diskette controller status A (PS/2)π         bit 7     interrupt pendingπ         bit 6     second drive installedπ         bit 5     stepπ         bit 4     track 0π         bit 3     head 1 selectπ         bit 2     indexπ         bit 1     write protectπ         bit 0     directionππ03F1    r    diskette controller status B (PS/2)π         bit 7-6  reservedπ         bit 5      drive select (0=A:, 1=B:)π         bit 4      write dataπ         bit 3      read dataπ         bit 2      write enableπ         bit 1      motor enable 1π         bit 0      motor enable 0ππ03F2    w    diskette controller DOR (Digital Output Register)π         bit 7-6    reserved PS/2π         bit 7 = 1  drive 3 motor enableπ         bit 6 = 1  drive 2 motor enableπ         bit 5 = 1  drive 1 motor enableπ         bit 4 = 1  drive 0 motor enableπ         bit 3 = 1  diskette DMA enable (reserved PS/2)π         bit 2 = 1  FDC enable    (controller reset)π               = 0  hold FDC at resetπ         bit 1-0    drive select (0=A 1=B ..)ππ03F4    r    diskette controller status registerπ         bit 7 = 1  data register is readyπ         bit 6 = 1  transfer is from controller to systemπ             0  transfer is from system to controllerπ         bit 5 = 1  non-DMA modeπ         bit 4 = 1  diskette controller busyπ         bit 3 = 1  drive 3 busy (reserved on PS/2)π         bit 2 = 1  drive 2 busy (reserved on PS/2)π         bit 1 = 1  drive 1 busyπ         bit 0 = 1  drive 0 busyππ03F5    r    diskette command status register 0π         bit 7-6      last command statusπ             = 00  command terminated successfullyπ             = 01  command terminated abnormallyπ             = 10  invalid commandπ             = 11  terminated abnormally by change in ready signalπ         bit 5     = 1   seek completedπ         bit 4     = 1  equipment check occurred after errorπ         bit 3     = 1  not readyπ         bit 2     = 1  head number at interruptπ         bit 1-0 = 1  unit select (0=A 1=B .. )π                  (on PS/2    01=A  10=B)ππ        status register 1π         bit 7        end of cylinder; sector# greater then sectors/trackπ         bit 6 = 0π         bit 5 = 1  CRC error in ID or data fieldπ         bit 4 = 1  overrunπ         bit 3 = 0π         bit 2 = 1  sector ID not foundπ         bit 1 = 1  write protect detected during writeπ         bit 0 = 1  ID address mark not foundππ        status register 2π         bit 7 = 0π         bit 6 = 1  deleted Data Eddress Mark detectedπ         bit 5 = 1  CRC error in dataπ         bit 4 = 1  wrong cylinder detectedπ         bit 3 = 1  scan command equal condition satisfiedπ         bit 2 = 1  scan command failed, sector not foundπ         bit 1 = 1  bad cylinder, ID not foundπ         bit 0 = 1  missing Data Address Mark ππ        status register 3π         bit 7        fault status signalπ         bit 6        write protect statusπ         bit 5        ready statusπ         bit 4        track zero statusπ         bit 3        two sided status signalπ         bit 2        side select (head select)π         bit 1-0    unit select (0=A 1=B .. )ππ03F6    r/w    FIXED disk controller data registerπ         bit 7-4    reservedπ         bit 3 = 0  reduce write currentπ             1  head select 3 enableπ         bit 2 = 1  disk reset enableπ             0  disk reset disableπ         bit 1 = 0  disk initialization enableπ             1  disk initialization disableπ         bit 0        reservedππ03F7    r    diskette controller DIR (Digital Input Register)π         bit 7 = 1 diskette changeππ         bit 6       FIXED DISK write gateπ         bit 5       FIXED DISK head select 3 / reduced write currentπ         bit 4       FIXED DISK head select 2π         bit 3       FIXED DISK head select 1π         bit 2       FIXED DISK head select 0π         bit 1       FIXED DISK drive 1 selectπ         bit 0       FIXED DISK drive 0 select   conflicts with:ππ         bit 0       diskette high density selectππ03F7    w    select register for diskette data transfer rateπ         bit 7-2       reservedπ         bit 1-0 = 00  500 Kb/S modeπ             = 01  300 Kb/S modeπ             = 10  250 Kb/S modeπ             = 11  reservedππ-------------------------------------------------------------------------------π03F8-03FF ----    serial port (8250,8251,16450,16550), same as 02E8,02F8,and 03F8ππ03F8    w    serial port, transmitter holding register, which contains theπ        character to be sent. Bit 0 is sent first.π         bit 7-0   data bits when DLAB=0 (Divisor Latch Access Bit)π    r    receiver buffer register, which contains the received characterπ        Bit 0 is received firstπ         bit 7-0   data bits when DLAB=0 (Divisor Latch Access Bit)π    r/w    divisor latch low byte when DLAB=1ππ03F9    r/w    divisor latch high byte when DLAB=1π    r/w    interrupt enable register when DLAB=0π         bits 7-4   reservedπ         bit 3 = 1  modem-status interrupt enableπ         bit 2 = 1  receiver-line-status interrupt enableπ         bit 1 = 1  transmitter-holding-register empty interrupt enableπ         bit 0 = 1  received-data-avail.int. enable (and 16550 timeout)ππ          - 16550 will interrupt if data exists in the FIFO and isn't readπ        within the time it takes to receive four bytes or if no data isπ        received within the time it takes to receive four bytesππ03FA    r    interrupt identification register. Information about a pendingπ        interrupt is stored here. When the ID register is addressed,π        the highest priority interrupt is held, and no other interruptsπ        are acknowledged until the CPU services that interrupt.π         bit 7-6 = 00  reserved on 8250, 8251, 16450π             = 11  if FIFO queues are enabled (16550 only)π         bit 5-4 = 0 reservedπ         bit 3     = 0 reserved  8250, 16450π             = 1 16550  timeout int. pendingπ         bit 2-1 identify pending interrupt with the highest priorityπ          = 11    receiver line status interrupt. priority=highestπ          = 10    received data available register interrupt. pr.=secondπ          = 01    transmitter holding register empty interrupt. pr.=thirdπ          = 00    modem status interrupt. priority=fourthπ         bit 0 = 0  interrupt pending. contents of register can be usedπ                as a pointer to the appropriate int.service routineπ             1  no interrupt pendingππ          - interrupt pending flag uses reverse logic, 0=pending, 1=noneπ          - interrupt will occur if any of the line status bits are setπ          - THRE bit is set when THRE register is emptied into the TSRπππ03FA    w    16650 FCR  (FIFO Control Register)π         bit 7-6 = 00  1 byteπ             = 01  4 bytesπ             = 10  8 bytesπ             = 11 14 bytesπ         bit 5-4 = 00 reservedπ         bit 3     = 1  change RXRDY  TXRDY pins from mode 0 to mode 1π         bit 2     = 1  clear XMIT FIFOπ         bit 1     = 1  clear RCVR FIFOπ         bit 0     = 1  enable clear XMIT and RCVR FIFO queuesππ          - bit 0 must be set in order to write to other FCR bitsπ          - bit 1 when set    the RCVR FIFO is cleared and this bit is resetπ         the receiver shift register is not clearedπ          - bit 2 when set    the XMIT FIFO is cleared and this bit is resetπ         the transmit shift register is not clearedππ03FB    r/w    line control registerπ         bit 7 = 1  divisor latch access bit (DLAB)π             0  receiver buffer, transmitter holding, or interruptπ                enable register accessπ         bit 6 = 1  set break enable. serial ouput is forced to spacingπ                state and remains there.π         bit 5 =    stick parityπ         bit 4 = 1  even parity selectπ         bit 3 =    parity enableπ             1  even number of ones are sent and checked in the π                data word bits and parity bitπ             0  odd number of ones are sent and checkedπ         bit 2 = 0  one stop bitπ             1  zero stop bitπ         bit 1-0 00 word length is 5 bitsπ             01 word length is 6 bitsπ             10 word length is 7 bitsπ             11 word length is 8 bitsππ03FC    r/w    modem control registerπ         bit 7-5 = 0  reservedπ         bit 4 = 1  loopback mode for diagnostic testing of serial portπ                output of transmitter shift register is looped backπ                to receiver shift register input. In this modeπ                transmitted data is received immediately so thatπ                the CPU can verify the transmit data/receive dataπ                serial port paths.π         bit 3 = 1  auxiliary user-designated output 2π         bit 2 = 1  auxiliary user-designated output 1π         bit 1 = 1  force request-to-send activeπ         bit 0 = 1  force data-terminal-ready activeππ03FD    r    line status registerπ         bit 7 = 0  reservedπ         bit 6 = 1  transmitter shift and holding registers emptyπ         bit 5 = 1  transmitter holding register empty. Controller isπ                ready toaccept a new character to send.π         bit 4 = 1  break interrupt. the received data input is held inπ                in the zero bit state longer than the time of startπ                bit + data bits + parity bit + stop bits.π         bit 3 = 1  framing error. the stop bit that follows the lastπ                parity or data bit is a zero bit.π         bit 2 = 1  parity error. Character has wrong parityπ         bit 1 = 1  overrun error. a character was sent to the receiverπ                buffer before the previous character in the bufferπ                could be read. This destroys the previousπ                character.π         bit 0 = 1  data ready. a complete incoming character has beenπ                received and sent to the receiver buffer register.ππ03FE    r    modem status registerπ         bit 7 = 1  data carrier detectπ         bit 6 = 1  ring indicatorπ         bit 5 = 1  data set readyπ         bit 4 = 1  clear to sendπ         bit 3 = 1  delta data carrier detectπ         bit 2 = 1  trailing edge ring indicatorπ         bit 1 = 1  delta data set readyπ         bit 0 = 1  delta clear to sendππ          - bits 0-3 are reset when the CPU reads the MSRπ          - bit 4 is the Modem Control Register RTS during loopback testπ          - bit 5 is the Modem Control Register DTR during loopback testπ          - bit 6 is the Modem Control Register OUT1 during loopback testπ          - bit 7 is the Modem Control Register OUT2 during loopback testππ03FF    r/w    scratch registerππ-------------------------------------------------------------------------------ππ        Adresses above 03FF apply to EISA machines only !ππ             1000-1FFF    slot 1 EISAπ             2000-2FFF    slot 2 EISAπ             3000-3FFF    slot 3 EISAπ             4000-4FFF    slot 4 EISAπ             5000-5FFF    slot 5 EISAπ             6000-6FFF    slot 6 EISAπ             7000-7FFF    slot 7 EISAππ-------------------------------------------------------------------------------π0401-04D6 ----    used by EISA systems onlyππ0401    r/w    DMA channel 0 word count byte 2 (high)π0403    r/w    DMA channel 1 word count byte 2 (high)π0405    r/w    DMA channel 2 word count byte 2 (high)π0407    r/w    DMA channel 3 word count byte 2 (high)ππ040A    w    extended DMA chaining mode register, channels 0-3π         bit 7-5      reservedπ         bit 4     = 0  generates IRQ13π             = 1  generates terminal countπ         bit 3     = 0  do not start chainingπ             = 1  programming completeπ         bit 2     = 0  disable buffer chaining mode (default)π             = 1  enable buffer chaining modeπ         bit 1-0      DMA channel selectππ040A    r    channel interrupt (IRQ13) status registerπ         bit 7-5  interrupt on channels 7-5π         bit 4      reservedπ         bit 3-0  interrupt on channels 3-0ππ040B    w    DMA extended mode register for channels 3-0.π        bit settings same as 04D6π         bit 7     = 0  enable stop registerπ         bit 6     = 0  terminal count is an output for this channelπ(default)π         bit 5-4      DMA cycle timingπ             = 00 ISA-compatible (default)π             = 01 type A timing modeπ             = 10 type B timing modeπ             = 11 burst DMA modeπ         bit 3-2      Address modeπ             = 00 8-bit I/O, count by bytes (default)π             = 01 16-bit I/O, count by words, address shiftedπ             = 10 32-bit I/O, count by bytesπ             = 11 16-bit I/O, count by bytesπ         bit 1-0      DMA channel selectππ-------------------------------------------------------------------------------π0461    r/w    Extended NMI status/control registerπ         bit 7 = 1  NMI pending from fail-safe timer (read only)π         bit 6 = 1  NMI pending from bus timeout NMI status (readπonly)π         bit 5 = 1  NMI pending (read only)π         bit 4        reservedπ         bit 3 = 1  bus timeout NMI enable (read/write)π         bit 2 = 1  fail-safe NMI enable (read/write)π         bit 1 = 1  NMI I/O port enable (read/write)π         bit 0        RSTDRV. bus reset (read/write)π               = 0  normal bus reset operationπ               = 1  reset bus assertedππ0462    w    Software NMI register. writing to this register causes an NMIπ        if NMI's are enabledπ         bit 7 = 1  generates an NMIππ0464    r    bus master status latch register (slots 1-8). identifies theπ        last bus master that had control of the busπ         bit 7 = 0  slot 8 had control lastπ         bit 6 = 0  slot 7 had control lastπ         bit 5 = 0  slot 6 had control lastπ         bit 4 = 0  slot 5 had control lastπ         bit 3 = 0  slot 4 had control lastπ         bit 2 = 0  slot 3 had control lastπ         bit 1 = 0  slot 2 had control lastπ         bit 0 = 0  slot 1 had control lastππ0465    r    bus master status latch register (slots 9-16)π         bit 7 = 0  slot 16 had control lastπ         bit 6 = 0  slot 15 had control lastπ         bit 5 = 0  slot 14 had control lastπ         bit 4 = 0  slot 13 had control lastπ         bit 3 = 0  slot 12 had control lastπ         bit 2 = 0  slot 11 had control lastπ         bit 1 = 0  slot 10 had control lastπ         bit 0 = 0  slot 9  had control lastππ-------------------------------------------------------------------------------π0481    r/w    DMA channel 2 address byte 3 (high)π0482    r/w    DMA channel 3 address byte 3 (high)π0483    r/w    DMA channel 1 address byte 3 (high)π0487    r/w    DMA channel 0 address byte 3 (high)π0489    r/w    DMA channel 6 address byte 3 (high)π048A    r/w    DMA channel 7 address byte 3 (high)π048B    r/w    DMA channel 5 address byte 3 (high)ππ04C6    r/w    DMA channel 5 word count byte 2 (high)π04CA    r/w    DMA channel 6 word count byte 2 (high)π04CE    r/w    DMA channel 7 word count byte 2 (high)ππ-------------------------------------------------------------------------------π04D0    w    IRQ 0-7 interrupt edge/level registersπ         bit 7 = 1  IRQ 7 is level sensitiveπ         bit 6 = 1  IRQ 6 is level sensitiveπ         bit 5 = 1  IRQ 5 is level sensitiveπ         bit 4 = 1  IRQ 4 is level sensitiveπ         bit 3 = 1  IRQ 3 is level sensitiveπ         bit 2-0    reservedππ04D1    w    IRQ 8-15 interrupt edge/level registersπ         bit 7 = 1  IRQ 15 is level sensitiveπ         bit 6 = 1  IRQ 14 is level sensitiveπ         bit 5 = 1  reservedπ         bit 4 = 1  IRQ 12 is level sensitiveπ         bit 3 = 1  IRQ 11 is level sensitiveπ         bit 2 = 1  IRQ 10 is level sensitiveπ         bit 1 = 1  IRQ 9  is level sensitiveπ         bit 0        reservedππ04D4    w    extended DMA chaining mode register, channels 4-7π         bit 7-5 = 0  reservedπ         bit 4     = 0  generates IRQ 13π             = 1  generates terminal countπ         bit 3     = 0  do not start chainingπ             = 1  programming completeπ         bit 2     = 0  disable buffer chaining mode (default)π             = 1  enable buffer chaining modeπ         bit 1-0      DMA channel selectππ04D6    w    DMA extended mode register for channels 4-7π        bit settings same as 04Bπ         bit 7     = 0  enable stop registerπ         bit 6     = 0  terminal count is an output for this channelπ(default)π         bit 5-4      DMA cycle timingπ             = 00 ISA-compatible (default)π             = 01 type A timing modeπ             = 10 type B timing modeπ             = 11 burst DMA modeπ         bit 3-2      Address modeπ             = 00 8-bit I/O, count by bytes (default)π             = 01 16-bit I/O, count by words, address shiftedπ             = 10 32-bit I/O, count by bytesπ             = 11 16-bit I/O, count by bytesπ         bit 1-0      DMA channel selectππ-------------------------------------------------------------------------------π0601    w    System control. Laptop chipset: Headland HL21 & Acer M5105π         bit 7 = 1  power led onπ         bit 6 = 1  LCD backlight offπ         bit 5π         bit 4π         bit 3π         bit 2 = 1  video chips disabled, screen blanked.π         bit 1π         bit 0 = 1  will lock up your machine!ππ    r     =04        (always reads back this value)ππ-------------------------------------------------------------------------------π0620-0627 ----    PC network (adapter 1)π0628-062F ----    PC network (adapter 2)ππ-------------------------------------------------------------------------------π06E2-06E3 ----    data aquisition (adapter 1)ππ-------------------------------------------------------------------------------π0790-0793 ----    cluster (adapter 1)ππ-------------------------------------------------------------------------------π0800-08FF ----    I/O port access registers for extended CMOS RAM or SRAMπ        (256 bytes at a time)π        Sometimes plain text can be seen here.ππ-------------------------------------------------------------------------------π0A20-0A23 ----    Token Ring (adapter 1)π0A24-0A27 ----    Token Ring (adapter 2)ππ-------------------------------------------------------------------------------π0AE2-0AE3 ----    cluster (adapter 2)π0B90-0B93 ----    cluster (adapter 2)ππ-------------------------------------------------------------------------------π0C00    r/w    page register to write to SRAM or I/Oππ-------------------------------------------------------------------------------π0C80-0C83 ----    system board ID registersππ-------------------------------------------------------------------------------π1390-1393 ----    cluster (adapter 3)ππ-------------------------------------------------------------------------------π2100-210F ----    IBM XGA (eXtended Graphics Adapter  8514/A)π2110-211F ----    IBM XGA (eXtended Graphics Adapter  8514/A)π2120-212F ----    IBM XGA (eXtended Graphics Adapter  8514/A)π2130-213F ----    IBM XGA (eXtended Graphics Adapter  8514/A)π2140-214F ----    IBM XGA (eXtended Graphics Adapter  8514/A)π2150-215F ----    IBM XGA (eXtended Graphics Adapter  8514/A)π2160-216F ----    IBM XGA (eXtended Graphics Adapter  8514/A)π2170-217F ----    IBM XGA (eXtended Graphics Adapter  8514/A)ππ-------------------------------------------------------------------------------π2390-2393 ----    cluster (adapter 4)ππ-------------------------------------------------------------------------------π3220-3227 ----    serial port 3, description same as 03F8π3228-322F ----    serial port 4, description same as 03F8ππ-------------------------------------------------------------------------------π3540-354F ----    IBM SCSI (Small Computer System Interface) adapterπ3550-355F ----    IBM SCSI (Small Computer System Interface) adapterπ3560-356F ----    IBM SCSI (Small Computer System Interface) adapterπ3570-357F ----    IBM SCSI (Small Computer System Interface) adapterππ-------------------------------------------------------------------------------π4220-4227 ----    serial port, description same as 03F8π4228-422F ----    serial port, description same as 03F8ππ-------------------------------------------------------------------------------π42E0-42EF ----    GPIB (General Purpose Interface Bus, IEEE 488 interface)ππ42E1    r/w    GPIB (adapter 2)ππ-------------------------------------------------------------------------------π5220-5227 ----    serial port, description same as 03F8π5228-522F ----    serial port, description same as 03F8ππ-------------------------------------------------------------------------------π62E0-62EF ----    GPIB (General Purpose Interface Bus, IEEE 488 interface)ππ62E1    r/w    GPIB (adapter 3)ππ-------------------------------------------------------------------------------π82E0-82EF ----    GPIB (General Purpose Interface Bus, IEEE 488 interface)ππ82E1    r/w    GPIB (adapter 4)ππ-------------------------------------------------------------------------------π82F8-82FF ----    serial port, description same as 03F8π83F8-83FF ----    serial port, description same as 03F8ππ-------------------------------------------------------------------------------πA220      ????    soundblaster support in AMI Hi-Flex BIOS  ????ππ-------------------------------------------------------------------------------πA2E0-A2EF ----    GPIB (General Purpose Interface Bus, IEEE 488 interface)ππA2E1    r/w    GPIB (adapter 5)ππ-------------------------------------------------------------------------------πAFFF    r/w    plane 0-3 system latch (video register)ππ-------------------------------------------------------------------------------πB220-B227 ----    serial port, description same as 03F8πB228-B22F ----    serial port, description same as 03F8ππ-------------------------------------------------------------------------------πC220-C227 ----    serial port, description same as 03F8πC228-C22F ----    serial port, description same as 03F8ππ-------------------------------------------------------------------------------πD220-D227 ----    serial port, description same as 03F8πD228-D22F ----    serial port, description same as 03F8ππ-------------------------------------------------------------------------------πC2E0-C2EF ----    GPIB (General Purpose Interface Bus, IEEE 488 interface)ππC2E1    r/w    GPIB (adapter 6)ππ-------------------------------------------------------------------------------πE2E0-E2EF ----    GPIB (General Purpose Interface Bus, IEEE 488 interface)ππE2E1    r/w    GPIB (adapter 7)πππ-------------------------------------------------------------------------------ππMEMORY-MAPPED ADDRESSESππ-------------------------------------------------------------------------------π80C00000  Compaq Deskpro 386 system memory board registerππ80C00000 w    RAM relocation registerπ        bit 7-2       Reserved, always write 1's.π        bit 1 = 0  Write-protect 128-Kbyte RAM at FE0000.π              = 1  Do not write-protect RAM at FE0000.π        bit 0 = 0  Relocate 128-Kbyte block at FE0000 to address 0E0000π              = 1  128-Kbyte RAM is addressed only at FE0000.ππ80C00000 r    Diagnostics registerπ        bit 7    = 0  memory expansion board is installedπ        bit 6    = 0  second 1 MB of system memory board is installedπ        bit 5-4 = 00 base memory set to 640 KBπ              01 invalidπ              10 base memory set to 512 KBπ              11 base memory set to 256 KBπ        bit 3    = 0  parity error in byte 3π        bit 2    = 0  parity error in byte 2π        bit 1    = 0  parity error in byte 1π        bit 0    = 0  parity error in byte 0 (in 32-bit double word)ππ-------------------------------------------------------------------------------πEarl L. Montgomery             HEXADECIMAL AND BINARY NOTATIONQBTIPS_J.DOC                   03-27-93 (19:40)       Text                   109  3584     HEX-BIN.DOC While refreshing my memory on Hexadecimal and Binary notationsπ(and the use of the logical operators <AND> <OR>, I found thatπit helped to take notes. This is a compilation of those notes.πSome phrasing is entirely my own. So if you find any mistakesπ(other than grammar, sentence structure, or spelling! <smile>)πplease inform me so I can correct my document file. Thisπdocument should prove useful to the new programmers.π π                     A little info on Hexadecimal notation.π πHexadecimal is a numbering system based on 16 elements.πDigits are numbered 0 through F as follows:π π0, 1, 2, 3, 4, 5, 6, 7, 8, 9, A, B, C, D, E, Fπ πRepresenting the digits 0 through 15.π πHexadecimal system uses powers of 16. For example:π&H19 (hexadecimal) represents 25 decimal. Let's see why.πStarting from the right the power is 1. Therefore 9 X 1 = 9πMoving left the next is power is 16. Therefore 1 X 16 = 16πAnd 9 + 16 = 25.π πLet's try another. This time &HFF (hexadecimal)πAgain starting from the right (F=15) 15 X 1= 15πMoving left 15 X 16 = 240.πAnd 240 + 15 = 255π πSo far we have looked at single byte hex values. Let's look atπa 16 bit hex value. Remember 8 bits to the byte? Now we look atπtwo adjoining bytes, or sixteen bits.π π&H1902 (hexadecimal) represents 6402 decimal.π πAgain starting from the right 2 X 1= 2πMoving left 0 X 16 = 0πMoving left again <16 X 16 =256> 9 X 256 = 2304πMoving left again <16 X 256 = 4096> 1 X 4096 = 4096πAnd 2 + 0 + 2304 + 4096 = 6402π πIn basic hex values are preceeded by &H. For example &HFF or &H1902πIn basic hex values can be determined by the command PRINT &HFFπor PRINT &H1902.π πDecimal to hex is accomplished by PRINT HEX$(255)πor PRINT HEX$(1902).π πNow let's look at the individual bits within a byte.π πRemember there are 8 bits to the byte and reading from Rightπto Left they increase in power by the power of 2.π πBinary notation reflects set bits with a 1. Non set bits with a 0.πLet's look at one.π π1 0 0 0 1 0 0 1 (This byte represents 137)πAs with hex we start at the right.π π1 X 1= 1πMoving left 2 X 0 = 0πMoving left again 4 X 0 = 0πMoving left again 8 X 1 = 8πMoving left again 16 X 0 = 0πMoving left again 32 X 0 = 0πMoving left again 64 X 0 = 0πMoving left again 128 X 1 = 128π πAnd 1 + 0 + 0 + 8 + 0 + 0 + 0 + 128 = 137π π                     Logical Operators <AND> <OR>π πWhen you AND two numbers the results are in a new third number.πFor example:πa = 137πb = 105πc = a AND bπ π1 0 0 0 1 0 0 1  This represents A <137>π0 1 1 0 1 0 0 1  This represents B <105>π π0 0 0 0 1 0 0 1  This represents C <9>π πWhat occurs when you AND two numbers is that the computer comparesπthe bits within the first number against the bits in the second number.πIf the bits are the same then they will remain the same in the thirdπnumber.πIf they are not the same then the equivalent bits will be 0 in theπthird number.π π π                               "Logical ORπ πWhat occurs when you OR two numbers is that the computer comparesπthe bits within the first number against the bits in the second number.πIf the bits are the same they will remain the same in the third number.πIf they are not the same then the bits will be 1 in the third number.π πFor example:πA=122πB=15πC=A OR Bπ π0 1 1 1 1 0 1 0   This represents A <122>π0 0 0 0 1 1 1 1   This represents B <15>π π0 1 1 1 1 1 1 1   This represents C <127>π πThis quick little reference document composed by Earl MontgomeryπI hope it proves to be of some use to you.πNicolas Culberson              CHRISTMAS HAK-MAN              [e-mail]            03-02-96 (00:00)       QB, QBasic, PDS        1051 31504    HAK-MAN.BAS '              **   Writen by Nicolas Culberson of Apoky!   **π'The whole HaK-MaN hasn't come out yet.. but I'm hopeing to get it out soon.π'The controls are easy.. right arrow, left, up arrow and space to shoot..π'if you would like to email me, reach me at:    [e-mail]πDECLARE SUB info ()πDECLARE SUB lev1 ()πDECLARE SUB die2 ()πDECLARE SUB menu ()πDECLARE SUB block ()πDECLARE SUB evilsanta ()πDECLARE SUB badman2 ()πDECLARE SUB badman ()πDECLARE SUB lev7 ()πDECLARE SUB blast ()πDECLARE SUB hitwallblast ()πDECLARE SUB takeoff ()πDECLARE SUB picture ()πDECLARE SUB secret ()πDECLARE SUB lev6 ()πDECLARE SUB lev5 ()πDECLARE SUB fallforward ()πDECLARE SUB lev4 ()πDECLARE SUB jumpfar ()πDECLARE SUB lev3 ()πDECLARE SUB fallpit ()πDECLARE SUB fallback ()πDECLARE SUB lev2 ()πDECLARE SUB hitwall ()πDECLARE SUB jumpright ()πDECLARE SUB hitself ()πDECLARE SUB die ()πDECLARE SUB forward ()πDECLARE SUB jump ()πDECLARE SUB backward ()πDECLARE SUB shoot ()πRANDOMIZE TIMERπDIM SHARED healπDIM SHARED bloodπDIM SHARED aπDIM SHARED bπDIM SHARED duhπDIM SHARED gunπDIM SHARED deathπDIM SHARED levπDIM SHARED bradπDIM SHARED bobπblood = 1πheal = 5πCLSπSCREEN 12π'CALL evilsanta      'unrem to go strait to the evil santa.πCALL menuπCALL lev2πCALL lev3πCALL lev4πCALL lev5πCALL lev6πCALL evilsantaπCALL lev7ππππππSUB backwardπCIRCLE (a, b), 5, 0: DRAW "c0u4u1r5u1l10d1r5u1l4u1e4f4l7e3f3l5e2f1l1"πa = a - 5πCIRCLE (a, b), 5, 15: DRAW "c0u4c15u1c15r5u1l10d1r5u1l4u1c12e4f4l7e3f3l5e2f1l1"πEND SUBππSUB badmanπCOLOR 10πPSET (a + 15, b + 6)πDRAW "r5u10l5d10"πPAINT (a + 16, b + 5), 2, 10πDOπIF da = 1000 THENπCOLOR 12πPAINT (a, b), 12, 15πIF blood = 1 THEN PSET (a, b - 10): DRAW "r3u2l1d3"πIF blood = 1 THEN PSET (a - 3, b - 10): DRAW "u3l2"πFOR cool = 1 TO 1000: NEXT coolπCOLOR 0πPAINT (a, b), 0, 15πIF blood = 1 THEN PSET (a, b - 10): DRAW "r3u2l1d3"πIF blood = 1 THEN PSET (a - 3, b - 10): DRAW "u3l2"πIF heal = 5 THEN CIRCLE (15, 115), 10, 0πIF heal = 4 THEN CIRCLE (15, 115), 8, 0πIF heal = 3 THEN CIRCLE (15, 115), 6, 0πIF heal = 2 THEN CIRCLE (15, 115), 4, 0πIF heal = 1 THEN CIRCLE (15, 115), 2, 0πIF heal = 0 THEN CALL dieπheal = heal - 1πIF heal = 5 THEN CIRCLE (15, 115), 10, 4πIF heal = 4 THEN CIRCLE (15, 115), 8, 4πIF heal = 3 THEN CIRCLE (15, 115), 6, 4πIF heal = 2 THEN CIRCLE (15, 115), 4, 12πIF heal = 1 THEN CIRCLE (15, 115), 2, 12πIF heal = 0 THEN CALL dieπda = 0πEND IFπda = da + 1πa$ = INKEY$πIF a$ = CHR$(27) THEN CALL menuπIF a$ = " " THENπIF blood = 0 THEN LINE (a + 10, b - 5)-(a + 20, b + 6), 0, BFπππjj = INT(RND * 2)ππIF blood = 1 AND jj = 0 THENπLINE (a + 10, b - 5)-(a + 20, b + 6), 12, BFπCOLOR 12πPSET (a + 10, b - 10): DRAW "r3u2l1d2"πPSET (a + 18, b - 10): DRAW "r4d2l1u5"πFOR cool = 1 TO 1000: NEXT coolπLINE (a + 10, b - 5)-(a + 20, b), 0, BFπCOLOR 0πPSET (a + 10, b - 10): DRAW "r3u2l1d2"πPSET (a + 18, b - 10): DRAW "r4d2l1u5"πCOLOR 12πPSET (a + 10, b + 7)πDRAW "d5r1u5r3d6r1u6r2d4u4r2d7r1u7"πFOR cool = 1 TO 1000: NEXT coolπLINE (a + 10, b - 5)-(a + 20, b + 6), 0, BFπPSET (a + 10, b + 7)πDRAW "d7r1u7r3d9r1u9r2d5u5r2d10r1u10"πEND IFππππIF blood = 1 AND jj = 1 THENπLINE (a + 10, b - 5)-(a + 20, b + 6), 12, BFπCOLOR 12πPSET (a + 10, b - 10): DRAW "r3u4l1u2"πPSET (a + 18, b - 10): DRAW "r4d2l3u4"πFOR cool = 1 TO 1000: NEXT coolπLINE (a + 10, b - 5)-(a + 20, b), 0, BFπCOLOR 0πPSET (a + 10, b - 10): DRAW "r3u4l1u2"πPSET (a + 18, b - 10): DRAW "r4d2l3u4"πCOLOR 12πPSET (a + 10, b + 7)πDRAW "d2r1u2r2d7r1u7r3d6r1u6r2d3r1u3"πFOR cool = 1 TO 1000: NEXT coolπLINE (a + 10, b - 5)-(a + 20, b + 6), 0, BFπPSET (a + 10, b + 7)πDRAW "d4r1u4r2d8r1u8r3d9r1u9r2d6r1u6"πEND IFππππk = 1πEND IFπLOOP UNTIL k = 1πdeath = death + 1πEND SUBπππππSUB badman2πCOLOR 15πPSET (a + 15, b + 6)πDRAW "r7u15l7d15"πPAINT (a + 16, b + 5), 15, 15πDOπIF da = 800 THENπCOLOR 12πPAINT (a, b), 12, 15πIF blood = 1 THEN PSET (a, b - 10): DRAW "r3u2l1d3"πIF blood = 1 THEN PSET (a - 3, b - 10): DRAW "u3l2"πIF lev < 6 THEN FOR cool = 1 TO 1000: NEXT coolπIF lev = 6 THEN FOR cool = 1 TO 500: NEXT coolπCOLOR 0πPAINT (a, b), 0, 15πIF blood = 1 THEN PSET (a, b - 10): DRAW "r3u2l1d3"πIF blood = 1 THEN PSET (a - 3, b - 10): DRAW "u3l2"πIF heal = 5 THEN CIRCLE (15, 115), 10, 0πIF heal = 4 THEN CIRCLE (15, 115), 8, 0πIF heal = 3 THEN CIRCLE (15, 115), 6, 0πIF heal = 2 THEN CIRCLE (15, 115), 4, 0πIF heal = 1 THEN CIRCLE (15, 115), 2, 0πIF heal = 0 THEN CALL dieπheal = heal - 1πIF heal = 5 THEN CIRCLE (15, 115), 10, 4πIF heal = 4 THEN CIRCLE (15, 115), 8, 4πIF heal = 3 THEN CIRCLE (15, 115), 6, 4πIF heal = 2 THEN CIRCLE (15, 115), 4, 12πIF heal = 1 THEN CIRCLE (15, 115), 2, 12πIF heal = 0 THEN CALL dieπda = 0πEND IFπda = da + 1πa$ = INKEY$πIF a$ = CHR$(27) THEN CALL menuπIF a$ = " " THENπIF blood = 0 THEN LINE (a + 10, b - 10)-(a + 23, b + 6), 0, BFπjjj = INT(RND * 2)ππIF blood = 1 AND jjj = 0 THENπLINE (a + 10, b - 10)-(a + 23, b + 6), 12, BFπCOLOR 12πPSET (a + 10, b - 10): DRAW "r3u2l1d2"πPSET (a + 18, b - 10): DRAW "r4d2l1u5"πFOR cool = 1 TO 1000: NEXT coolπLINE (a + 10, b - 10)-(a + 23, b), 0, BFπCOLOR 0πPSET (a + 10, b - 10): DRAW "r3u2l1d2"πPSET (a + 18, b - 10): DRAW "r4d2l1u5"πCOLOR 12πPSET (a + 10, b + 7)πDRAW "d6r1u6d1r1u1r3d6r1u6r2d8r1u8r3d10r1u10r1d5r1u5"πFOR cool = 1 TO 1000: NEXT coolπLINE (a + 10, b - 5)-(a + 23, b + 6), 0, BFπPSET (a + 10, b + 7)πDRAW "d12r1u12d1r1u1r3d8r1u8r2d13r1u13r3d15r1u15r1d8r1u8"πEND IFπIF blood = 1 AND jjj = 1 THENπLINE (a + 10, b - 10)-(a + 23, b + 6), 12, BFπCOLOR 12πPSET (a + 12, b - 10): DRAW "l3u2r1d2"πPSET (a + 18, b - 10): DRAW "r4d4l2u3"πFOR cool = 1 TO 1000: NEXT coolπLINE (a + 10, b - 10)-(a + 23, b), 0, BFπCOLOR 0πPSET (a + 12, b - 10): DRAW "l3u2r1d2"πPSET (a + 18, b - 10): DRAW "r4d4l2u3"πCOLOR 12πPSET (a + 10, b + 7)πDRAW "d4r1u4d6r1u6r3d3r1u3r2d4r1u4r3d15r1u15r1d8r1u8"πFOR cool = 1 TO 1000: NEXT coolπLINE (a + 10, b - 5)-(a + 23, b + 6), 0, BFπPSET (a + 10, b + 7)πDRAW "d6r1u6d8r1u8r3d5r1u5r2d8r1u8r3d16r1u16r1d11r1u11"πEND IFππk = 1πEND IFπLOOP UNTIL k = 1πdeath = death + 1πIF blood = 0 AND lev = 2 OR blood = 0 AND lev = 6 THEN FOR cool = 1 TO 1000: NEXT coolπEND SUBππSUB blockπhmm = b - 50ππDOπCOLOR 12πPSET (a - 5, hmm)πDRAW "r10u10l10d10"πPAINT (a + 1, hmm - 1), 3, 12πFOR cool = 1 TO 500: NEXT coolπPAINT (a + 1, hmm - 1), 0, 12πPSET (a - 5, hmm), 0πDRAW "r10u10l10d10"πhmm = hmm + 10πIF hmm = b THEN CALL dieπa$ = INKEY$πIF a = 130 AND a$ = " " THENπPAINT (151, 81), 12, 14πFOR cool = 1 TO 1000: NEXT coolπPAINT (151, 81), 13, 14πIF brad = 4 THENπIF blood = 1 THENπCOLOR 12πLINE (a + 10, b - 80)-(a + 50, b + 5), 12, BFπFOR cool = 1 TO 500: NEXT coolπLINE (a + 10, b - 80)-(a + 50, b - 70), 0, BFπPSET (a + 10, b + 6)πDRAW "d10r1u10r1d2r1u2r3d15r1u15r2d9r1u9r1d8r1u8r5d14r1u14r1d15r1u15r6d16r1u16r5d5r1u5r2d18r1u18r1d12r1u12r1d4r1u4"πFOR cool = 1 TO 500: NEXT coolπLINE (a + 10, b - 80)-(a + 50, b - 60), 0, BFπPSET (a + 10, b + 6)πDRAW "d14r1u14r1d3r1u3r3d17r1u17r2d13r1u13r1d11r1u11r5d16r1u16r1d19r1u19r6d21r1u21r5d8r1u8r2d18r1u18r1d16r1u16r1d8r1u8"πFOR cool = 1 TO 500: NEXT coolπLINE (a + 10, b - 80)-(a + 50, b - 50), 0, BFπPSET (a + 10, b + 6)πDRAW "d17r1u17r1d9r1u9r3d23r1u23r2d19r1u19r1d14r1u14r5d20r1u20r1d26r1u26r6d25r1u25r5d13r1u13r2d27r1u27r1d19r1u19r1d12r1u12"πFOR cool = 1 TO 500: NEXT coolπLINE (a + 10, b - 80)-(a + 50, b - 40), 0, BFπPSET (a + 10, b + 6)πDRAW "d23r1u23r1d13r1u13r3d28r1u28r2d29r1u29r1d19r1u19r5d26r1u26r1d28r1u28r6d30r1u30r5d19r1u19r2d33r1u33r1d24r1u24r1d17r1u17"πFOR cool = 1 TO 500: NEXT coolπLINE (a + 10, b - 80)-(a + 50, b - 30), 0, BFπPSET (a + 10, b + 6)πDRAW "d29r1u29r1d17r1u17r3d35r1u35r2d37r1u37r1d25r1u25r5d29r1u29r1d36r1u36r6d36r1u36r5d24r1u24r2d39r1u39r1d27r1u27r1d21r1u21"πFOR cool = 1 TO 500: NEXT coolπLINE (a + 10, b - 80)-(a + 50, b - 20), 0, BFπPSET (a + 10, b + 6)πDRAW "d34r1u34r1d26r1u26r3d39r1u39r2d42r1u42r1d28r1u28r5d35r1u35r1d40r1u40r6d39r1u39r5d29r1u29r2d47r1u47r1d33r1u33r1d25r1u25"πFOR cool = 1 TO 500: NEXT coolπLINE (a + 10, b - 80)-(a + 50, b - 10), 0, BFπPSET (a + 10, b + 6)πDRAW "d39r1u39r1d35r1u35r3d47r1u47r2d46r1u46r1d35r1u35r5d38r1u38r1d44r1u44r6d45r1u45r5d36r1u36r2d47r1u47r1d38r1u38r1d29r1u29"πFOR cool = 1 TO 500: NEXT coolπLINE (a + 10, b - 80)-(a + 50, b), 0, BFπPSET (a + 10, b + 6)πDRAW "d47r1u47r1d36r1u36r3d50r1u50r2d51r1u51r1d38r1u38r5d43r1u43r1d47r1u47r6d48r1u48r5d44r1u44r2d49r1u49r1d45r1u45r1d35r1u35"πFOR cool = 1 TO 500: NEXT coolπLINE (a + 10, b - 80)-(a + 50, b + 5), 0, BFπPSET (a + 10, b + 6)πDRAW "d53r1u52r1d39r1u39r3d55r1u55r2d57r1u57r1d43r1u43r5d48r1u48r1d53r1u53r6d55r1u55r5d49r1u49r2d54r1u54r1d48r1u48r1d39r1u39"πFOR cool = 1 TO 500: NEXT coolπEND IFπCALL lev7πEND IFπbrad = brad + 1πEND IFπIF a = 125 AND a$ = CHR$(0) + "M" THEN a$ = "Yo"πIF a = 130 AND a$ = CHR$(0) + "M" THEN a$ = "Yo"πLOOP UNTIL a$ = CHR$(0) + "M" OR a$ = CHR$(0) + "K"πIF a$ = CHR$(0) + "K" THEN CALL backwardπIF a$ = CHR$(0) + "K" THEN CALL backward: a = a + 10πIF a$ = CHR$(0) + "M" THEN CALL forwardπIF a$ = CHR$(0) + "M" THEN CALL forward: a = a - 10πDOπCOLOR 12πPSET (a - 5, hmm)πDRAW "r10u10l10d10"πPAINT (a + 1, hmm - 1), 3, 12πFOR cool = 1 TO 500: NEXT coolπPAINT (a + 1, hmm - 1), 0, 12πPSET (a - 5, hmm), 0πDRAW "r10u10l10d10"πhmm = hmm + 10πLOOP UNTIL hmm = bπCOLOR 12πPSET (a - 5, b + 7)πDRAW "d10r2u7r2d12r2u12r2d6r2u6r2d8r2u11l14"πPAINT (a - 3, b + 8), 3, 12πPAINT (a, b + 8), 3, 12πIF a$ = CHR$(0) + "K" THEN a = a - 10πIF a$ = CHR$(0) + "M" THEN a = a + 10πa$ = "Yo"πdeath = death + 1πEND SUBππSUB dieπIF blood = 0 THEN LINE (a - 10, b - 10)-(a + 10, b + 5), 0, BFπIF blood = 1 THENπLINE (a - 10, b - 10)-(a + 10, b + 5), 12, BFπFOR cool = 1 TO 500: NEXT coolπLINE (a - 10, b - 10)-(a + 10, b - 5), 0, BFπPSET (a - 10, b + 6), 12πDRAW "d10r1u10r2d12r1u12r3d9r1u9r5d13r1u13r2d8r1u8r3d12r1u12"πFOR cool = 1 TO 500: NEXT coolπLINE (a - 10, b - 10)-(a + 10, b), 0, BFπPSET (a - 10, b + 6), 12πDRAW "d13r1u13r2d17r1u17r3d11r1u11r5d15r1u15r2d10r1u10r3d13r1u13"πFOR cool = 1 TO 500: NEXT coolπLINE (a - 10, b - 10)-(a + 10, b + 4), 0, BFπPSET (a - 10, b + 6), 12πDRAW "d16r1u16r1d3u3l1r2d19r1u19r3d13r1u13r5d17r1u17r2d13r1u13r3d16r1u16"πFOR cool = 1 TO 1000: NEXT coolπEND IFπCOLOR 12πPALETTE 15, 0πFOR x = 1 TO 63 STEP 1πPALETTE 15, x '* 256πPALETTE 0, 63 - xπLOCATE 15, 35: PRINT "Game Over"πNEXT xπPALETTEπCALL menuπEND SUBππππππSUB die2πCOLOR 12πPALETTE 15, 0πFOR x = 1 TO 63 STEP 1πPALETTE 15, x '* 256πPALETTE 0, 63 - xπLOCATE 15, 35: PRINT "Game Over"πNEXT xπPALETTEπCALL menuπENDπEND SUBππSUB evilsantaπendsanta = 1πCLSπCOLOR 2πPSET (0, 0)πDRAW "r200d100l200u100"πPSET (1, 90)πDRAW "r199"πPAINT (1, 91), 4, 2πCOLOR 14πPSET (150, 30)πDRAW "r30d58l40u10r10r30l30u5h5u5e5 u2r30l30u8  r10e5g5l10l5u5r5u12"πPAINT (151, 31), 8, 14πPSET (160, 60)πDRAW "r10d10l10u10d15r3u2d2r3u2d2r3u2d2u4"πPSET (155, 35)πDRAW "r5d5l5u5"πPAINT (156, 36), 12, 14πPAINT (151, 81), 13, 14πCOLOR 15πPSET (150, 29)πDRAW "r30u5l30d5"πPAINT (153, 25), 15, 15πCOLOR 12πPSET (155, 23)πDRAW "e10f10l20"πPAINT (157, 22), 12, 12πCOLOR 15πPSET (163, 13)πDRAW "r5u5l5d5"πPAINT (164, 12), 15, 15πa = 10πb = 84πCIRCLE (a, b), 5, 15: DRAW "c0u4c15u1c15r5u1l10d1r5u1l4u1c12e4f4l7e3f3l5e2f1l1"πFOR x = 1 TO 200πa$ = INKEY$πIF a$ = CHR$(27) THEN CALL menuπIF a = 130 AND a$ = " " THEN a$ = "Yo"πIF a = 130 AND a$ = CHR$(0) + "M" THEN a$ = "Yo"πIF a = 60 THENπCOLOR 2πPSET (a - 6, b + 5)πDRAW "u100"πEND IFπIF a = 60 AND a$ = CHR$(0) + "K" THEN a$ = "Yo"πIF a = 10 AND a$ = CHR$(0) + "K" THEN a$ = "Yo"πIF a$ = " " THEN CALL shootπIF a$ = CHR$(0) + "M" THEN CALL forwardπIF a$ = CHR$(0) + "H" THEN CALL jumpπIF a$ = CHR$(0) + "K" THEN CALL backwardπIF a > 70 AND a < 135 THEN CALL blockπIF x = 199 THEN x = 1πNEXT xπENDπEND SUBππSUB fallbackπCIRCLE (a, b), 5, 0: DRAW "c0u4u1r5u1l10d1r5u1l4u1e4f4l7e3f3l5e2f1l1"πa = a - 10πb = b + 10πCIRCLE (a, b), 5, 15: DRAW "c0u4c15u1c15r5u1l10d1r5u1l4u1c12e4f4l7e3f3l5e2f1l1"πEND SUBππSUB fallforwardπCIRCLE (a, b), 5, 0: DRAW "c0u4u1r5u1l10d1r5u1l4u1e4f4l7e3f3l5e2f1l1"πa = a + 10πb = b + 10πCIRCLE (a, b), 5, 15: DRAW "c0u4c15u1c15r5u1l10d1r5u1l4u1c12e4f4l7e3f3l5e2f1l1"πEND SUBππSUB fallpitπCIRCLE (a, b), 5, 0: DRAW "c0u4u1r5u1l10d1r5u1l4u1e4f4l7e3f3l5e2f1l1"πCIRCLE (a + 7, b + 10), 5, 15: DRAW "c0u4c15u1c15r5u1l10d1r5u1l4u1c12e4f4l7e3f3l5e2f1l1"πFOR cool = 1 TO 500: NEXT coolπCIRCLE (a + 7, b + 10), 5, 0: DRAW "c0u4u1r5u1l10d1r5u1l4u1e4f4l7e3f3l5e2f1l1"πCIRCLE (a + 7, b + 20), 5, 15: DRAW "c0u4c15u1c15r5u1l10d1r5u1l4u1c12e4f4l7e3f3l5e2f1l1"πFOR cool = 1 TO 500: NEXT coolπCIRCLE (a + 7, b + 20), 5, 0: DRAW "c0u4u1r5u1l10d1r5u1l4u1e4f4l7e3f3l5e2f1l1"πCIRCLE (a + 7, b + 30), 5, 15: DRAW "c0u4c15u1c15r5u1l10d1r5u1l4u1c12e4f4l7e3f3l5e2f1l1"πFOR cool = 1 TO 500: NEXT coolπCIRCLE (a + 7, b + 30), 5, 0: DRAW "c0u4u1r5u1l10d1r5u1l4u1e4f4l7e3f3l5e2f1l1"πCIRCLE (a + 7, b + 40), 5, 15: DRAW "c0u4c15u1c15r5u1l10d1r5u1l4u1c12e4f4l7e3f3l5e2f1l1"πFOR cool = 1 TO 500: NEXT coolπCIRCLE (a + 7, b + 40), 5, 0: DRAW "c0u4u1r5u1l10d1r5u1l4u1e4f4l7e3f3l5e2f1l1"πCIRCLE (a + 7, b + 50), 5, 15: DRAW "c0u4c15u1c15r5u1l10d1r5u1l4u1c12e4f4l7e3f3l5e2f1l1"πFOR cool = 1 TO 500: NEXT coolπIF duh = 1 THEN CALL lev6π'IF duh = 2 THEN CALL secretπIF duh = 3 THEN CIRCLE (a + 7, b + 50), 5, 0: DRAW "c0u4u1r5u1l10d1r5u1l4u1e4f: GOTO 1"πCALL die2π1πEND SUBππππππππSUB forwardπCOLOR 0πCIRCLE (a, b), 5, 0: DRAW "c0u4u1r5u1l10d1r5u1l4u1e4f4l7e3f3l5e2f1l1"πa = a + 5πCIRCLE (a, b), 5, 15: DRAW "c0u4c15u1c15r5u1l10d1r5u1l4u1c12e4f4l7e3f3l5e2f1l1"πEND SUBππSUB hitselfπPAINT (a, b), 12, 15πCOLOR 12πIF blood = 1 THEN PSET (a - 5, b - 12): DRAW "u4l3d1r3d1l3"πFOR cool = 1 TO 1000: NEXT coolπPAINT (a, b), 0, 15πCOLOR 0πIF blood = 1 THEN PSET (a - 5, b - 12): DRAW "u4l3d1r3d1l3"πIF blood = 1 THEN COLOR 12: PSET (a - 10, b + 7): DRAW "d3r1u3r2d2r1u2"πIF heal = 5 THEN CIRCLE (15, 115), 10, 0πIF heal = 4 THEN CIRCLE (15, 115), 8, 0πIF heal = 3 THEN CIRCLE (15, 115), 6, 0πIF heal = 2 THEN CIRCLE (15, 115), 4, 0πIF heal = 1 THEN CIRCLE (15, 115), 2, 0πIF heal = 0 THEN CALL dieπheal = heal - 1πIF heal = 5 THEN CIRCLE (15, 115), 10, 4πIF heal = 4 THEN CIRCLE (15, 115), 8, 4πIF heal = 3 THEN CIRCLE (15, 115), 6, 4πIF heal = 2 THEN CIRCLE (15, 115), 4, 12πIF heal = 1 THEN CIRCLE (15, 115), 2, 12πIF heal = 0 THEN CALL dieπEND SUBππSUB hitwallπCOLOR 10πPSET (a + 10, b - 3)πDRAW "h1f1d5g1l1e1u5h1"πFOR cool = 1 TO 1000: NEXT coolπCOLOR 0πPSET (a + 10, b - 3)πDRAW "h1f1d5g1l1e1u5h1"πEND SUBππSUB infoπCLSπSCREEN 0πCOLOR 15πPRINTπCOLOR 30πPRINT "                           ***CHRISTMAS HaK-MaN***"πCOLOR 15πPRINTπPRINT "The Controls..."πPRINTπPRINT "Up arrow /\ is Jump"πPRINT "Left arrow < is walk backwards"πPRINT "Right arrow > is walk forwards"πPRINT "Space bar --- is shoot"πPRINTπPRINT "If you want to jump up and go right you must be at a wall... "πPRINTπPRINT "Menu..."πPRINTπPRINT "The menu is very easy, just press the button in [] you wish to use. "πPRINT "Blood.."πPRINT "If you do not want blood press B at the main menu and that will turn"πPRINT "it off. If you want it back on just press B again. "πPRINT "      Every time you go back to the menu the blood will turn on."πPRINT "Press a key..."πSLEEPπPRINTπPRINT "In the game..."πPRINTπPRINT "If you want the time in the middle of the game you can just press T"πPRINT "If you want to quit in the middle of a game press ESC"πPRINTπPRINT "The last boss..."πPRINTπPRINT "The last boss is very hard but you must get past him. Why?, I donno."πPRINT "You must shoot the evilsantas feet to kill him.  What will happen is"πPRINT "there will be blocks falling after two moves past the wall that pops"πPRINT "up.  You must move in and hit him then get out of the way as fast as"πPRINT "posible. "πPRINTπPRINT "If you can't beat the evilsanta or can't get past the levels here is"πPRINT "what it says: "πPRINTπPRINT "You have won CHRISTMAS VERSION"πPRINT "of HaK-MaN.If you enjoyed this"πPRINT "please DL the whole HaK-MaN.  If you"πPRINT "didn't enjoy this, DL the whole HaK-MaN"πPRINT "Press a key..."πSLEEPπPRINT "because it is alot better. The full"πPRINT "version includes:"πPRINTπPRINT "1) More levels (but harder)"πPRINT "2) More badguys(but harder)"πPRINT "3) PC sounds"πPRINT "4) Lots of cool pictures"πPRINT "5) More Guns!!!!!!!"πPRINT "6) 4 x the screen size (400x200)"πCOLOR 31: PRINT "AND MUCH MORE! "πCOLOR 15πPRINTπPRINT "Press Enter..."πDOπIF INKEY$ = CHR$(13) THEN SCREEN 12: CALL menuπLOOPπππENDπCALL menuπEND SUBππSUB jumpπCIRCLE (a, b), 5, 0: DRAW "c0u4u1r5u1l10d1r5u1l4u1e4f4l7e3f3l5e2f1l1"πCIRCLE (a, b - 10), 5, 15: DRAW "c0u4c15u1c15r5u1l10d1r5u1l4u1c12e4f4l7e3f3l5e2f1l1"πFOR cool = 1 TO 1000: NEXT coolπCIRCLE (a, b - 10), 5, 0: DRAW "c0u4u1r5u1l10d1r5u1l4u1e4f4l7e3f3l5e2f1l1"πCIRCLE (a, b), 5, 15: DRAW "c0u4c15u1c15r5u1l10d1r5u1l4u1c12e4f4l7e3f3l5e2f1l1"πEND SUBππSUB jumpfarπCIRCLE (a, b), 5, 0: DRAW "c0u4u1r5u1l10d1r5u1l4u1e4f4l7e3f3l5e2f1l1"πCIRCLE (a + 7, b - 10), 5, 15: DRAW "c0u4c15u1c15r5u1l10d1r5u1l4u1c12e4f4l7e3f3l5e2f1l1"πFOR cool = 1 TO 1000: NEXT coolπCIRCLE (a + 7, b - 10), 5, 0: DRAW "c0u4u1r5u1l10d1r5u1l4u1e4f4l7e3f3l5e2f1l1"πa = a + 15πCIRCLE (a, b), 5, 15: DRAW "c0u4c15u1c15r5u1l10d1r5u1l4u1c12e4f4l7e3f3l5e2f1l1"πEND SUBππSUB jumprightπCIRCLE (a, b), 5, 0: DRAW "c0u4u1r5u1l10d1r5u1l4u1e4f4l7e3f3l5e2f1l1"πCIRCLE (a + 5, b - 15), 5, 15: DRAW "c0u4c15u1c15r5u1l10d1r5u1l4u1c12e4f4l7e3f3l5e2f1l1"πFOR cool = 1 TO 1000: NEXT coolπCIRCLE (a + 5, b - 15), 5, 0: DRAW "c0u4u1r5u1l10d1r5u1l4u1e4f4l7e3f3l5e2f1l1"πa = a + 10πb = b - 10πCIRCLE (a, b), 5, 15: DRAW "c0u4c15u1c15r5u1l10d1r5u1l4u1c12e4f4l7e3f3l5e2f1l1"πEND SUBππSUB lev1πheal = 5πlev = lev + 1πCOLOR 2πPSET (0, 0)πDRAW "r200d100l200u100"πPSET (1, 90)πDRAW "r50u10r30d20r20u20r60u10r38"πPAINT (3, 93), 9, 2πPAINT (133, 93), 9, 2πCOLOR 14πPSET (62, 50)πDRAW "r5u5l5d5"πPAINT (63, 49), 6, 14πIF heal = 5 THEN CIRCLE (15, 115), 10, 4πIF heal = 4 THEN CIRCLE (15, 115), 8, 4πIF heal = 3 THEN CIRCLE (15, 115), 6, 4πIF heal = 2 THEN CIRCLE (15, 115), 4, 12πIF heal = 1 THEN CIRCLE (15, 115), 2, 12πIF heal = 0 THEN CALL dieπa = 10πb = 83πCIRCLE (a, b), 5, 15: DRAW "c0u4c15u1c15r5u1l10d1r5u1l4u1c12e4f4l7e3f3l5e2f1l1"πFOR x = 1 TO 200πa$ = INKEY$πIF a = 195 THEN CALL lev2πIF a$ = "T" OR a$ = "t" THEN COLOR 1: LOCATE 16, 1: PRINT TIME$: LOCATE 16, 1: SLEEP: PRINT "                   "πIF a = 190 AND a$ = " " THEN CALL hitwall: a$ = "Yo"πIF a = 15 AND death = 0 OR a = 55 AND death = 1 OR a = 95 AND death = 2 OR a = 135 AND death = 3 OR a = 175 AND death = 4 THEN CALL badmanπIF a = 195 THEN x = 200πIF a = 80 AND a$ = CHR$(0) + "M" AND bridge = 0 THENπCIRCLE (a, b), 5, 0: DRAW "c0u4u1r5u1l10d1r5u1l4u1e4f4l7e3f3l5e2f1l1"πCIRCLE (a + 10, b + 10), 5, 15: DRAW "c0u4c15u1c15r5u1l10d1r5u1l4u1c12e4f4l7e3f3l5e2f1l1"πFOR cool = 1 TO 500: NEXT coolπCIRCLE (a + 10, b + 10), 5, 0: DRAW "c0u4u1r5u1l10d1r5u1l4u1e4f4l7e3f3l5e2f1l1"πCIRCLE (a + 10, b + 20), 5, 15: DRAW "c0u4c15u1c15r5u1l10d1r5u1l4u1c12e4f4l7e3f3l5e2f1l1"πCALL die2πEND IFπIF a = 10 AND a$ = CHR$(0) + "K" THEN a$ = "b"πIF a = 45 AND a$ = CHR$(0) + "M" OR a = 155 AND a$ = CHR$(0) + "M" THEN a$ = "b"πIF a = 45 AND a$ = CHR$(0) + "H" OR a = 155 AND a$ = CHR$(0) + "H" THEN CALL jumpright: a$ = "b"πIF a = 45 AND a$ = " " OR a = 155 AND a$ = " " THEN CALL hitself: a$ = "b"πIF a = 40 AND a$ = " " OR a = 150 AND a$ = " " THEN CALL hitwall: a$ = "b"πIF a = 55 AND a$ = CHR$(0) + "K" OR a = 165 AND a$ = CHR$(0) + "K" THEN CALL fallback: a$ = "b"πIF a$ = CHR$(27) THEN CALL menuπIF a$ = CHR$(0) + "M" THEN CALL forwardπIF a$ = CHR$(0) + "H" THEN CALL jumpπIF a$ = CHR$(0) + "K" THEN CALL backwardπIF a$ = " " THEN CALL shootπIF a = 65 AND a$ = CHR$(0) + "H" AND bridge = 0 THENπCOLOR 15πPSET (a + 16, b + 7)πDRAW "r20"πbridge = 1πPAINT (63, 49), 12, 14πa$ = "b"πEND IFπIF a = 65 AND a$ = CHR$(0) + "H" AND bridge = 1 THENπCOLOR 0πPSET (a + 17, b + 7)πDRAW "r18 "πbridge = 0πPAINT (63, 49), 6, 14πEND IFπIF x = 199 THEN x = 1πNEXT xπEND SUBππSUB lev2πlev = lev + 1πCLSπCOLOR 2πPSET (0, 0)πDRAW "r200d100l200u100"πPSET (1, 70)πDRAW "r50u10r50u10r30d50r12u50r28d50r12u50r16"πPAINT (3, 93), 9, 2πPAINT (153, 93), 9, 2πPAINT (196, 93), 9, 2πIF heal = 5 THEN CIRCLE (15, 115), 10, 4πIF heal = 4 THEN CIRCLE (15, 115), 8, 4πIF heal = 3 THEN CIRCLE (15, 115), 6, 4πIF heal = 2 THEN CIRCLE (15, 115), 4, 12πIF heal = 1 THEN CIRCLE (15, 115), 2, 12πIF heal = 0 THEN CALL dieπa = 10πb = 63πCIRCLE (a, b), 5, 15: DRAW "c0u4c15u1c15r5u1l10d1r5u1l4u1c12e4f4l7e3f3l5e2f1l1"πFOR x = 1 TO 200πa$ = INKEY$πIF a = 195 THEN CALL lev3πIF a$ = "T" OR a$ = "t" THEN COLOR 1: LOCATE 16, 1: PRINT TIME$: LOCATE 16, 1: SLEEP: PRINT "                   "πIF a = 190 AND a$ = " " THEN CALL hitwall: a$ = "Yo"πIF a = 15 AND death = 5 OR a = 55 AND death = 6 OR a = 105 AND death = 7 OR a = 145 AND death = 8 THEN CALL badmanπIF a = 195 THEN x = 200πIF a = 145 AND a$ = CHR$(0) + "K" OR a = 185 AND a$ = CHR$(0) + "K" THEN a$ = "b"πIF a = 130 AND a$ = CHR$(0) + "H" OR a = 170 AND a$ = CHR$(0) + "H" THEN CALL jumpfar: a$ = "b"πIF a = 130 AND a$ = CHR$(0) + "M" OR a = 170 AND a$ = CHR$(0) + "M" THEN CALL fallpit: a$ = "b"πIF a = 10 AND a$ = CHR$(0) + "K" THEN a$ = "b"πIF a = 45 AND a$ = CHR$(0) + "M" OR a = 95 AND a$ = CHR$(0) + "M" THEN a$ = "b"πIF a = 45 AND a$ = CHR$(0) + "H" OR a = 95 AND a$ = CHR$(0) + "H" THEN CALL jumpright: a$ = "b"πIF a = 45 AND a$ = " " OR a = 95 AND a$ = " " THEN CALL hitself: a$ = "b"πIF a = 40 AND a$ = " " OR a = 90 AND a$ = " " THEN CALL hitwall: a$ = "b"πIF a = 55 AND a$ = CHR$(0) + "K" OR a = 105 AND a$ = CHR$(0) + "K" THEN CALL fallback: a$ = "b"πIF a$ = CHR$(27) THEN CALL menuπIF a$ = CHR$(0) + "M" THEN CALL forwardπIF a$ = CHR$(0) + "H" THEN CALL jumpπIF a$ = CHR$(0) + "K" THEN CALL backwardπIF a$ = " " THEN CALL shootπIF x = 199 THEN x = 1πNEXT xπEND SUBππSUB lev3πlev = lev + 1πCLSπCOLOR 2πPSET (0, 0)πDRAW "r200d100l200u100"πPSET (1, 50)πDRAW "r30d50r12u50r28u10r50d10r50u20r29d20l29r5u15l5"πPAINT (3, 93), 9, 2πPAINT (93, 93), 9, 2πPAINT (198, 45), 1, 2πIF heal = 5 THEN CIRCLE (15, 115), 10, 4πIF heal = 4 THEN CIRCLE (15, 115), 8, 4πIF heal = 3 THEN CIRCLE (15, 115), 6, 4πIF heal = 2 THEN CIRCLE (15, 115), 4, 12πIF heal = 1 THEN CIRCLE (15, 115), 2, 12πIF heal = 0 THEN CALL dieπa = 10πb = 43πCIRCLE (a, b), 5, 15: DRAW "c0u4c15u1c15r5u1l10d1r5u1l4u1c12e4f4l7e3f3l5e2f1l1"πFOR x = 1 TO 200πa$ = INKEY$πIF a = 170 THEN CALL lev4πIF a$ = "T" OR a$ = "t" THEN COLOR 1: LOCATE 16, 1: PRINT TIME$: LOCATE 16, 1: SLEEP: PRINT "                   "πIF a = 190 AND a$ = " " THEN CALL hitwall: a$ = "Yo"πIF a = 45 AND death = 9 THEN CALL badman2πIF a = 95 AND death = 10 THEN CALL badmanπIF a = 135 AND death = 11 THEN CALL badman2πIF a = 170 THEN x = 200πIF a = 130 AND a$ = CHR$(0) + "K" THEN a$ = "b"πIF a = 120 AND a$ = CHR$(0) + "M" THEN CALL fallforward: a$ = "b"πIF a = 30 AND a$ = CHR$(0) + "H" THEN CALL jumpfar: a$ = "b"πIF a = 30 AND a$ = CHR$(0) + "M" THEN CALL fallpit: a$ = "b"πIF a = 10 AND a$ = CHR$(0) + "K" THEN a$ = "b"πIF a = 45 AND a$ = CHR$(0) + "K" THEN a$ = "b"πIF a = 65 AND a$ = CHR$(0) + "M" THEN a$ = "b"πIF a = 65 AND a$ = CHR$(0) + "H" THEN CALL jumpright: a$ = "b"πIF a = 65 AND a$ = " " OR a = 165 AND a$ = " " THEN CALL hitself: a$ = "b"πIF a = 60 AND a$ = " " OR a = 160 AND a$ = " " THEN CALL hitwall: a$ = "b"πIF a = 75 AND a$ = CHR$(0) + "K" THEN CALL fallback: a$ = "b"πIF a$ = CHR$(27) THEN CALL menuπIF a$ = CHR$(0) + "M" THEN CALL forwardπIF a$ = CHR$(0) + "H" THEN CALL jumpπIF a$ = CHR$(0) + "K" THEN CALL backwardπIF a$ = " " THEN CALL shootπIF x = 199 THEN x = 1πNEXT xπEND SUBπππππππSUB lev4πlev = lev + 1πCLSπdeath = 0πCOLOR 7πPSET (0, 0)πDRAW "r200d100l200u100"πPSET (1, 90)πDRAW "r30u10r50u10r30d10r40d10r48"πPAINT (3, 93), 8, 7πCOLOR 14πPSET (10, 1)πDRAW "d20g5r10h5"πIF duh = 2 THENπduh = 3πa = 10πb = 33πCALL fallpitπduh = 0πEND IFπIF heal = 5 THEN CIRCLE (15, 115), 10, 4πIF heal = 4 THEN CIRCLE (15, 115), 8, 4πIF heal = 3 THEN CIRCLE (15, 115), 6, 4πIF heal = 2 THEN CIRCLE (15, 115), 4, 12πIF heal = 1 THEN CIRCLE (15, 115), 2, 12πIF heal = 0 THEN CALL dieπa = 10πb = 83πCIRCLE (a, b), 5, 15: DRAW "c0u4c15u1c15r5u1l10d1r5u1l4u1c12e4f4l7e3f3l5e2f1l1"πFOR x = 1 TO 200πa$ = INKEY$πIF a$ = "T" OR a$ = "t" THEN COLOR 1: LOCATE 16, 1: PRINT TIME$: LOCATE 16, 1: SLEEP: PRINT "                   "πIF a = 190 AND a$ = " " THEN CALL hitwall: a$ = "Yo"πIF a = 45 AND death = 0 THEN CALL badman2πIF a = 85 AND death = 1 THEN CALL badman2πIF a = 125 AND death = 2 THEN CALL badman2πIF a = 165 AND death = 3 THEN CALL badmanπIF a = 195 THEN CALL lev5πIF a = 110 AND a$ = CHR$(0) + "M" OR a = 150 AND a$ = CHR$(0) + "M" THEN CALL fallforward: a$ = "b"πIF a = 10 AND a$ = CHR$(0) + "K" THEN a$ = "b"πIF a = 120 AND a$ = CHR$(0) + "K" OR a = 160 AND a$ = CHR$(0) + "K" THEN a$ = "b"πIF a = 25 AND a$ = CHR$(0) + "M" OR a = 75 AND a$ = CHR$(0) + "M" THEN a$ = "b"πIF a = 25 AND a$ = CHR$(0) + "H" OR a = 75 AND a$ = CHR$(0) + "H" THEN CALL jumpright: a$ = "b"πIF a = 75 AND a$ = " " OR a = 25 AND a$ = " " THEN CALL hitself: a$ = "b"πIF a = 70 AND a$ = " " OR a = 20 AND a$ = " " THEN CALL hitwall: a$ = "b"πIF a = 85 AND a$ = CHR$(0) + "K" OR a = 35 AND a$ = CHR$(0) + "K" THEN CALL fallback: a$ = "b"πIF a$ = CHR$(27) THEN CALL menuπIF a$ = CHR$(0) + "M" THEN CALL forwardπIF a$ = CHR$(0) + "H" THEN CALL jumpπIF a$ = CHR$(0) + "K" THEN CALL backwardπIF a$ = " " THEN CALL shootπIF x = 199 THEN x = 1πNEXT xπENDπEND SUBππSUB lev5πlev = 2πdeath = 0πCLSπCOLOR 2πPSET (0, 0)πDRAW "r200d100l200u100"πPSET (1, 50)πDRAW "r40d50r12u50r28d50r12u50r28d50r12u50r28u10r20d60"πCOLOR 12πPSET (192, 10)πDRAW "r3d5r3g5h5r3u5"πPAINT (194, 12), 4, 12πPAINT (3, 93), 9, 2πPAINT (63, 93), 9, 2πPAINT (113, 93), 9, 2πPAINT (173, 93), 9, 2πIF heal = 5 THEN CIRCLE (15, 115), 10, 4πIF heal = 4 THEN CIRCLE (15, 115), 8, 4πIF heal = 3 THEN CIRCLE (15, 115), 6, 4πIF heal = 2 THEN CIRCLE (15, 115), 4, 12πIF heal = 1 THEN CIRCLE (15, 115), 2, 12πIF heal = 0 THEN CALL dieπa = 10πb = 43πCIRCLE (a, b), 5, 15: DRAW "c0u4c15u1c15r5u1l10d1r5u1l4u1c12e4f4l7e3f3l5e2f1l1"πFOR x = 1 TO 200πa$ = INKEY$πIF a$ = "T" OR a$ = "t" THEN COLOR 1: LOCATE 16, 1: PRINT TIME$: LOCATE 16, 1: SLEEP: PRINT "                   "πIF a = 15 AND death = 0 THEN CALL badman2πIF a = 15 AND death = 1 THEN CALL badman2πIF a = 55 AND death = 2 THEN CALL badman2πIF a = 55 AND death = 3 THEN CALL badman2πIF a = 140 AND death = 4 THEN CALL badmanπIF a = 190 AND a$ = " " THEN CALL hitwall: a$ = "Yo"πIF a = 120 AND a$ = CHR$(0) + "M" THEN duh = 2πIF a = 180 AND a$ = CHR$(0) + "M" THEN duh = 1πIF a = 40 AND a$ = CHR$(0) + "H" OR a = 80 AND a$ = CHR$(0) + "H" OR a = 120 AND a$ = CHR$(0) + "H" THEN CALL jumpfar: a$ = "b"πIF a = 40 AND a$ = CHR$(0) + "M" OR a = 80 AND a$ = CHR$(0) + "M" OR a = 120 AND a$ = CHR$(0) + "M" OR a = 180 AND a$ = CHR$(0) + "M" THEN CALL fallpit: a$ = "b"πIF a = 10 AND a$ = CHR$(0) + "K" THEN a$ = "b"πIF a = 155 AND a$ = CHR$(0) + "M" THEN a$ = "b"πIF a = 55 AND a$ = CHR$(0) + "K" OR a = 95 AND a$ = CHR$(0) + "K" OR a = 135 AND a$ = CHR$(0) + "K" THEN a$ = "b"πIF a = 155 AND a$ = CHR$(0) + "H" THEN CALL jumpright: a$ = "b"πIF a = 165 AND a$ = CHR$(0) + "K" THEN CALL fallback: a$ = "b"πIF a = 155 AND a$ = " " THEN CALL hitself: a$ = "b"πIF a = 150 AND a$ = " " THEN CALL hitwall: a$ = "b"πIF a$ = CHR$(27) THEN CALL menuπIF a$ = CHR$(0) + "M" THEN CALL forwardπIF a$ = CHR$(0) + "H" THEN CALL jumpπIF a$ = CHR$(0) + "K" THEN CALL backwardπIF a$ = " " THEN CALL shootπIF x = 199 THEN x = 1πNEXT xπEND SUBππSUB lev6πdeath = 0πlev = 6πCLSπCOLOR 2πPSET (0, 0)πDRAW "r200d100l200u100"πPSET (50, 1)πDRAW "d89r101u90l30d60l50u60"πPAINT (3, 93), 9, 2πPAINT (85, 3), 9, 2πCOLOR 13πPSET (131, 89)πDRAW "r19u30l19d30"πPAINT (132, 87), 2, 13πIF heal = 5 THEN CIRCLE (15, 115), 10, 4πIF heal = 4 THEN CIRCLE (15, 115), 8, 4πIF heal = 3 THEN CIRCLE (15, 115), 6, 4πIF heal = 2 THEN CIRCLE (15, 115), 4, 12πIF heal = 1 THEN CIRCLE (15, 115), 2, 12πIF heal = 0 THEN CALL dieπa = 60πb = 83πCIRCLE (a, b), 5, 15: DRAW "c0u4c15u1c15r5u1l10d1r5u1l4u1c12e4f4l7e3f3l5e2f1l1"πFOR x = 1 TO 200πa$ = INKEY$πIF a$ = "T" OR a$ = "t" THEN COLOR 1: LOCATE 16, 1: PRINT TIME$: LOCATE 16, 1: SLEEP: PRINT "                   "πIF a = 70 AND death = 0 THEN CALL badman2πIF a = 70 AND death = 1 THEN CALL badman2πIF a = 70 AND death = 2 THEN CALL badman2πIF a = 75 AND death = 3 THEN CALL badman2πIF a = 75 AND death = 4 THEN CALL badman2πIF a = 75 AND death = 5 THEN CALL badman2πIF a = 90 AND death = 6 THEN CALL badman2πIF a = 90 AND death = 7 THEN CALL badman2πIF a = 90 AND death = 8 THEN CALL badman2ππIF a = 190 AND a$ = " " THEN CALL hitwall: a$ = "Yo"πIF a = 125 THEN x = 200πIF a = 60 AND a$ = CHR$(0) + "K" THEN a$ = "b"πIF a = 125 AND a$ = " " THEN CALL hitself: a$ = "b"πIF a = 120 AND a$ = " " THEN CALL hitwall: a$ = "b"πIF a$ = CHR$(27) THEN CALL menuπIF a$ = CHR$(0) + "M" THEN CALL forwardπIF a$ = CHR$(0) + "H" THEN CALL jumpπIF a$ = CHR$(0) + "K" THEN CALL backwardπIF a$ = " " THEN CALL shootπIF x = 199 THEN x = 1πNEXT xπCALL evilsantaπEND SUBππSUB lev7πCOLOR 4πCLSπSCREEN 0πCOLOR 15πLOCATE 1, 1πPRINT "You have won the CHRISTMAS VERSION"πPRINT "of HaK-MaN.If you enjoyed this"πPRINT "please DL the whole HaK-MaN.  If you"πPRINT "didn't enjoy this, DL the whole HaK-MaN"πPRINT "because it is alot better. The full"πPRINT "version includes:"πPRINTπPRINT "1) More levels (but harder)"πPRINT "2) More badguys(but harder)"πPRINT "3) PC sounds"πPRINT "4) Lots of cool pictures"πPRINT "5) More Guns!!!!!!!"πPRINT "6) 4 x the screen size (400x200)"πCOLOR 31: PRINT "AND MUCH MORE! "πCOLOR 15: PRINTπPRINT "Press Enter..."πDOπIF INKEY$ = CHR$(13) THEN ENDπLOOPπSCREEN 12πENDπEND SUBππSUB menuπblood = 1πCLSπCOLOR 12πPSET (130, 100)πDRAW "r350d200l350u200"πPAINT (131, 103), 1, 12πCOLOR 10πLOCATE 10, 20πPRINT "[P]lay Christmas HaK-MaN"πLOCATE 12, 20πPRINT "[B]lood  Yes  No"πCOLOR 13πLOCATE 12, 28: PRINT "*"πLOCATE 14, 20πCOLOR 10πPRINT "[I]nfo on Christmas HaK-MaN"πLOCATE 16, 20πPRINT "[E]xit Christmas HaK-MaN"πCOLOR 8πPSET (140, 99)πDRAW "u10r350d200l9u190l340"πPAINT (145, 98), 8, 8πFOR x = 1 TO 200πa$ = INKEY$πIF a$ = "P" OR a$ = "p" THEN x = 200πIF a$ = "E" OR a$ = "e" THEN ENDπIF a$ = "I" OR a$ = "i" THEN CALL infoπIF a$ = "B" AND blood = 1 OR a$ = "b" AND blood = 1 THENπCOLOR 0πLOCATE 12, 28: PRINT "*"πCOLOR 13πLOCATE 12, 33πPRINT "*"πa$ = "Yo"πblood = 0πEND IFπIF blood = 0 AND a$ = "b" OR blood = 0 AND a$ = "B" THENπCOLOR 0πLOCATE 12, 33: PRINT "*"πCOLOR 13πLOCATE 12, 28πPRINT "*"πa$ = "Yo"πblood = 1πEND IFπIF x = 199 THEN x = 1πNEXT xπCLSπdeath = 0πCALL lev1πEND SUBπππππππSUB shootπCOLOR 10πPSET (a + 10, b - 3)πDRAW "r3d6l3r2u3l2r2u1"πFOR cool = 1 TO 1000πNEXT coolπCOLOR 0πPSET (a + 10, b - 3)πDRAW "r3d6l3r2u3l2r2u1"πEND SUBππTim Desper                     FIRE STORM                     pages.nyu.edu/~jqm1584/        03-06-96 (09:55)       QB, QBasic, PDS        808  21023    FIRE.BAS    '        |-----                 /-------    |π'        |                      |         --|--π'        |----  -  |___  ___    \------\    |  /--\ |___ |\  /|π'        |      |  |    /___\          |    |  |  | |    | \/ |π'        |      |  |    \___     ------/    |  \__/ |    |    |π'             π'π'π'π'    ===================================================================π'    ===================================================================π'                           By Tim Desper & Co.π'      π'      π'    ===================================================================π'    ===================================================================π'π'πSHELL "mode con: rate=32 delay=1"πSHELL "cls"πDIM paz(1 TO 1000)πDIM ded(1 TO 5000)π6 SCREEN 12: CLSπPSET (30, 40), (4): DRAW "r22l22d50u25r25"πPSET (70, 40), (4): DRAW "r25l12d50l12r25"πPSET (125, 40), (4): DRAW "r25d25l25u25d50u25f25"πPSET (180, 40), (4): DRAW "r25l25d25r12l12d25r25"πPSET (330, 40), (4): DRAW "r25l25d25r25d25l25"πPSET (390, 40), (4): DRAW "r25l12d50"πPSET (450, 40), (4): DRAW "r25d50l25u50"πPSET (510, 40), (4): DRAW "r25d25l25u25d50u25f25"πPSET (570, 40), (4): DRAW "d50u50f12e12d50"πLOCATE 12, 34: PRINT "VERSION 1.0"πLOCATE 14, 38: PRINT "by"πLOCATE 15, 32: PRINT "Tim Desper & Co."πLOCATE 20, 29: PRINT "Please Press Space Bar"πDOπSELECT CASE INKEY$πCASE CHR$(32): EXIT DOπEND SELECTπLOOPπ34 CLEARπSCREEN 12: CLSπPAINT (1, 1), 8πPSET (10, 60): DRAW "r55l55d100u50r50"πPSET (70, 60): DRAW "r50l25d100l25r50"πPSET (125, 60): DRAW "r50d50l50u50d100u50f50"πPSET (180, 60): DRAW "r50l50d50r25l25d50r50"πPSET (330, 60): DRAW "r50l50d50r50d50l50"πPSET (390, 60): DRAW "r50l25d100"πPSET (450, 60): DRAW "r50d100l50u100"πPSET (510, 60): DRAW "r50d50l50u50d100u50f50"πPSET (570, 60): DRAW "d100u100f25e25d100"πLOCATE 17, 40: PRINT "START"πLOCATE 20, 40: PRINT "INSTRUCTIONS"πLOCATE 23, 40: PRINT "REGISTRATION"πa = 180: b = 262πCIRCLE (a, b), 40, , , , (2 / 15)πLINE (a + 40, b)-(a + 50, b)πDOπSELECT CASE INKEY$πCASE CHR$(0) + "M" 'rightπCIRCLE (a, b), 40, 8, , , (2 / 15)πLINE (a + 40, b)-(a + 50, b), 8πSELECT CASE bπCASE 262: b = 310πCASE 310: b = 359πCASE 359: b = 262πEND SELECTπCASE CHR$(0) + "P" 'downπCIRCLE (a, b), 40, 8, , , (2 / 15)πLINE (a + 40, b)-(a + 50, b), 8πSELECT CASE bπCASE 262: b = 310πCASE 310: b = 359πCASE 359: b = 262πEND SELECTπCASE CHR$(0) + "K" 'leftπCIRCLE (a, b), 40, 8, , , (2 / 15)πLINE (a + 40, b)-(a + 50, b), 8πSELECT CASE bπCASE 262: b = 359πCASE 310: b = 262πCASE 359: b = 310πEND SELECTπCASE CHR$(0) + "H" 'upπCIRCLE (a, b), 40, 8, , , (2 / 15)πLINE (a + 40, b)-(a + 50, b), 8πSELECT CASE bπCASE 262: b = 359πCASE 310: b = 262πCASE 359: b = 310πEND SELECTπCASE CHR$(32)πSELECT CASE bπCASE 262: GOTO 17πCASE 310πCLSπLOCATE 7, 15: PRINT "In Firestorm you are the oval shaped ship. You"πLOCATE 8, 15: PRINT "move up, down, left, and right by using the"πLOCATE 9, 15: PRINT "arrow keys. You shoot by pressing the space bar."πLOCATE 10, 15: PRINT "To pause the game press the p button. You can end the"πLOCATE 11, 15: PRINT "game at any point by pressing the e button. In level 1"πLOCATE 12, 15: PRINT "if you or the circles touch the border then you"πLOCATE 13, 15: PRINT "(or the circles) are transported to another place"πLOCATE 14, 15: PRINT "on the screen. You will not be able to shoot the"πLOCATE 15, 15: PRINT "level 1 boss until you shoot all of the small circles."πLOCATE 16, 15: PRINT "Sometimes you will run across invisible small circles."πLOCATE 17, 15: PRINT "Those are the hardest to shoot but are worth the most points."πLOCATE 18, 15: PRINT "If you have any problems when using Spacewar"πLOCATE 19, 15: PRINT "then E-mail me at [e-mail] and let me know."πLOCATE 22, 26: PRINT "press spacebar to continue"πDOπSELECT CASE INKEY$πCASE "e": GOTO 33πCASE "E": GOTO 33πCASE CHR$(32): GOTO 34πEND SELECTπLOOPπCASE 359πCLSπLOCATE 9, 17: PRINT "The full version of Firestorm isn't finished yet."πLOCATE 10, 17: PRINT "Firestorm version 2.0 will have registration info"πLOCATE 11, 17: PRINT "and will run a lot better than Firestorm version 1.0."πLOCATE 12, 17: PRINT "Look for it sometime early '96."πLOCATE 13, 17: PRINT "If you are interested in registering Firestorm"πLOCATE 14, 17: PRINT "let me know. E-mail me at [e-mail] and"πLOCATE 15, 17: PRINT "tell me what you think of Firestorm, along with "πLOCATE 16, 17: PRINT "any suggestions and ideas you have for it."πLOCATE 20, 26: PRINT "press spacebar to continue"πDOπSELECT CASE INKEY$πCASE "e": GOTO 33πCASE "E": GOTO 33πCASE CHR$(32): GOTO 34πEND SELECTπLOOPπEND SELECTπCASE "e": GOTO 33πCASE "E": GOTO 33πEND SELECTπCIRCLE (a, b), 40, , , , (2 / 15)πLINE (a + 40, b)-(a + 50, b)πLOOPπ17 SCREEN 12: CLSπqqqq = 0πLOCATE 14, 35: PRINT "level 1"πDOπqqqq = qqqq + 1πLOOP UNTIL qqqq = 5000πLOCATE 16, 30: PRINT "                "πLOCATE 17, 20: PRINT "                                     "πLOCATE 28, 43: PRINT "press p to pause and e to quit"πqwe = 0πRANDOMIZE TIMERπFOR ab = 1 TO 150π  ac = INT(RND * 629) + 1π  ad = INT(RND * 429) + 1π  PSET (ac, ad)πNEXT abπa = 50πb = 240πCIRCLE (a, b), 40, , , , (2 / 15)πLINE (a + 40, b)-(a + 50, b)πm = 450πn = 300πx = 500πy = 270πvc = 9πcx = 14πop = 470πpo = 270πlevel = 1πlife = 3πcleer = 0πCIRCLE (m, n), 10, vcπCIRCLE (x, y), 10, cxπCONST true = -1πCONST false = NOT trueπLOCATE 28, 5: PRINT "level:"πLOCATE 28, 17: PRINT "lives:"πLOCATE 28, 28: PRINT "score:"π100 DOπLINE (1, 1)-(630, 430), 8, BπLINE (1, 430)-(630, 479), 8, BπLOCATE 28, 11: PRINT levelπLOCATE 28, 23: PRINT lifeπLOCATE 28, 34: PRINT scoreπwwww = wwww + 1πIF wwww = 50 THEN LOCATE 14, 35: PRINT "       "πIF chan = true AND (score MOD 800) = 0 THENπchan = falseπlife = life + 1πEND IFπIF bn >= 16 AND bn < 31 AND ty < 40 THENπIF bn = 30 THEN uj = 1          ' no more circlesπCIRCLE (op, po), 75, 0πml = ml + 1πIF ml < 100 THEN po = po - 1πIF ml > 100 THEN po = po + 1πIF ml >= 200 THEN ml = 0πIF bn < 30 THEN clo = 7πIF bn = 30 THEN clo = 9πCIRCLE (op, po), 75, cloπRANDOMIZE TIMERπnl = INT(RND * 30) + 1πSELECT CASE nlπCASE 10πRANDOMIZE TIMERπbl = INT(RND * 6) + 1πSELECT CASE blπCASE IS < 7πchange = trueπEND SELECTπCASE ELSE: change = falseπEND SELECTπEND IFπIF change = true THENπSELECT CASE blπCASE 1πol = opπoo = poπoll = opπooo = poπDOπqi = qi + 1πIF (oll - 10) < (a + 50) AND (oll - 10) > (a - 40) AND ooo < (b + 15) AND ooo > (b - 15) THEN GOTO 1πIF (ol - 10) < (a + 50) AND (ol - 10) > (a - 40) AND oo < (b + 15) AND oo > (b - 15) THEN GOTO 1πLINE (ol, oo - 60)-(ol - 10, oo - 60), 0πLINE (oll, ooo)-(oll - 10, ooo), 0πol = ol - 50πoll = oll - 50πLINE (ol, oo - 60)-(ol - 10, oo - 60), 4πLINE (oll, ooo)-(oll - 10, ooo), 4πLOOP UNTIL qi >= 50πqi = 0πCASE 2πol = opπoo = poπoll = opπooo = poπDOπqi = qi + 1πIF (oll - 10) < (a + 50) AND (oll - 10) > (a - 40) AND ooo < (b + 15) AND ooo > (b - 15) THEN GOTO 1πIF (ol - 10) < (a + 50) AND (ol - 10) > (a - 40) AND oo < (b + 15) AND oo > (b - 15) THEN GOTO 1πLINE (ol, oo - 40)-(ol - 10, oo - 40), 0πLINE (oll, ooo)-(oll - 10, ooo), 0πol = ol - 50πoll = oll - 50πLINE (ol, oo - 40)-(ol - 10, oo - 40), 4πLINE (oll, ooo)-(oll - 10, ooo), 4πLOOP UNTIL qi >= 50πqi = 0πCASE 3πol = opπoo = poπoll = opπooo = poπDOπqi = qi + 1πIF (oll - 10) < (a + 50) AND (oll - 10) > (a - 40) AND ooo < (b + 15) AND ooo > (b - 15) THEN GOTO 1πIF (ol - 10) < (a + 50) AND (ol - 10) > (a - 40) AND oo < (b + 15) AND oo > (b - 15) THEN GOTO 1πLINE (ol, oo + 60)-(ol - 10, oo + 60), 0πLINE (oll, ooo)-(oll - 10, ooo), 0πol = ol - 50πoll = oll - 50πLINE (ol, oo + 60)-(ol - 10, oo + 60), 4πLINE (oll, ooo)-(oll - 10, ooo), 4πLOOP UNTIL qi >= 50πqi = 0πCASE 4πol = opπoo = poπoll = opπooo = poπDOπqi = qi + 1πIF (oll - 10) < (a + 50) AND (oll - 10) > (a - 40) AND ooo < (b + 15) AND ooo > (b - 15) THEN GOTO 1πIF (ol - 10) < (a + 50) AND (ol - 10) > (a - 40) AND oo < (b + 15) AND oo > (b - 15) THEN GOTO 1πLINE (ol, oo + 40)-(ol - 10, oo + 40), 0πLINE (oll, ooo)-(oll - 10, ooo), 0πol = ol - 50πoll = oll - 50πLINE (ol, oo + 40)-(ol - 10, oo + 40), 4πLINE (oll, ooo)-(oll - 10, ooo), 4πLOOP UNTIL qi >= 50πqi = 0πCASE 5πol = opπoo = poπoll = opπooo = poπool = opπloo = poπDOπqi = qi + 1πIF (ool - 10) < (a + 50) AND (ool - 10) > (a - 40) AND loo < (b + 15) AND loo > (b - 15) THEN GOTO 1πIF (oll - 10) < (a + 50) AND (oll - 10) > (a - 40) AND ooo < (b + 15) AND ooo > (b - 15) THEN GOTO 1πIF (ol - 10) < (a + 50) AND (ol - 10) > (a - 40) AND oo < (b + 15) AND oo > (b - 15) THEN GOTO 1πLINE (ol, oo - 60)-(ol - 10, oo - 60), 0πLINE (ool, loo + 60)-(ool - 10, loo + 60), 0πLINE (oll, ooo)-(oll - 10, ooo), 0πol = ol - 50πoll = oll - 50πool = ool - 50πLINE (ol, oo - 60)-(ol - 10, oo - 60), 4πLINE (ool, loo + 60)-(ool - 10, loo + 60), 4πLINE (oll, ooo)-(oll - 10, ooo), 4πLOOP UNTIL qi >= 50πqi = 0πCASE 6πol = opπoo = poπoll = opπooo = poπool = opπloo = poπDOπqi = qi + 1πIF (ool - 10) < (a + 50) AND (ool - 10) > (a - 40) AND loo < (b + 15) AND loo > (b - 15) THEN GOTO 1πIF (oll - 10) < (a + 50) AND (oll - 10) > (a - 40) AND ooo < (b + 15) AND ooo > (b - 15) THEN GOTO 1πIF (ol - 10) < (a + 50) AND (ol - 10) > (a - 40) AND oo < (b + 15) AND oo > (b - 15) THEN GOTO 1πLINE (ol, oo - 40)-(ol - 10, oo - 40), 0πLINE (ol, oo + 40)-(ol - 10, oo + 40), 0πLINE (ol, oo)-(ol - 10, oo), 0πool = ool - 50πoll = oll - 50πol = ol - 50πLINE (ol, oo - 40)-(ol - 10, oo - 40), 4πLINE (oll, ooo + 40)-(oll - 10, ooo + 40), 4πLINE (ool, loo)-(ool - 10, loo), 4πLOOP UNTIL qi >= 50πqi = 0πEND SELECTπEND IFπIF circ = 1 AND sfd = 1 AND uj = 0 THENπRANDOMIZE TIMERπvc = INT(RND * 16)πcx = INT(RND * 16)π2 m = INT(RND * 600) + 1πIF m < 20 THEN GOTO 2π3 n = INT(RND * 450) + 1πIF n < 20 THEN GOTO 3π4 x = INT(RND * 600) + 1πIF x < 20 THEN GOTO 4π5 y = INT(RND * 450) + 1πIF y < 20 THEN GOTO 5πcirc = 0πsfd = 0πEND IFπIF level = 2 THEN GOTO 333πIF m <= 1 OR m >= 630 OR n <= 1 OR n >= 425 THENπCIRCLE (m, n), 10, 0πRANDOMIZE TIMERπm = INT(RND * 600) + 1πn = INT(RND * 450) + 1πLOCATE 28, 5: PRINT "level:"πLOCATE 28, 17: PRINT "lives:"πLOCATE 28, 28: PRINT "score:"πLOCATE 28, 43: PRINT "press p to pause and e to quit"πELSEIF x <= 1 OR x >= 630 OR y <= 1 OR y >= 425 THENπCIRCLE (x, y), 10, 0πRANDOMIZE TIMERπx = INT(RND * 600) + 1πy = INT(RND * 450) + 1πLOCATE 28, 5: PRINT "level:"πLOCATE 28, 17: PRINT "lives:"πLOCATE 28, 28: PRINT "score:"πLOCATE 28, 43: PRINT "press p to pause and e to quit"πEND IFπIF (a - 40) <= 1 OR (a + 50) >= 630 OR (b - 10) <= 1 OR (b + 10) >= 425 THENπCIRCLE (a, b), 40, 0, , , (2 / 15)πLINE (a + 40, b)-(a + 50, b), 0πRANDOMIZE TIMERπa = INT(RND * 600) + 1πb = INT(RND * 450) + 1πCIRCLE (a, b), 40, , , , (2 / 15)πLINE (a + 40, b)-(a + 50, b)πLOCATE 28, 5: PRINT "level:"πLOCATE 28, 17: PRINT "lives:"πLOCATE 28, 28: PRINT "score:"πLOCATE 28, 43: PRINT "press e to quit and p to pause"πEND IFπRANDOMIZE TIMERπIF circ = 0 THENπxy = INT(RND * 5) + 1πSELECT CASE xyπCASE 1πCIRCLE (m, n), 10, 0πm = m + 10πCIRCLE (m, n), 10, vcπCASE 2πCIRCLE (m, n), 10, 0πm = m - 10πCIRCLE (m, n), 10, vcπCASE 3πCIRCLE (m, n), 10, 0πn = n - 10πCIRCLE (m, n), 10, vcπCASE 4πCIRCLE (m, n), 10, 0πn = n + 10πCIRCLE (m, n), 10, vcπCASE 5πRANDOMIZE TIMERπaw = INT(RND * ((vc + 10) * 2)) + 1πSELECT CASE awπCASE 20πaz = mπFOR aa = 1 TO 130πIF (az - 30) <= (a + 50) AND (az - 30) >= (a - 50) AND n < (b + 20) AND n > (b - 20) THENπ1 life = life - 1πDOπjk = jk + 1πCIRCLE (a, b), jk, 4πLOOP UNTIL jk = 70πjk = 80πDOπjk = jk - 1πCIRCLE (a, b), jk, 0πLOOP UNTIL jk = 0πIF life = 0 THEN GOTO 333πGET (180, 179)-(440, 251), dedπLINE (180, 179)-(440, 251), 15, BπLINE (181, 180)-(439, 250), 8, BFπDOπSELECT CASE INKEY$πCASE CHR$(32): fill0 = 0: EXIT DOπCASE "e": GOTO 33πCASE "E": GOTO 33πEND SELECTπLINE (181, 180)-(439, 250), 8, BπIF fill0 = 0 THENπCOLOR 15πLOCATE 13, 30: PRINT "You disappoint me."πLOCATE 15, 26: PRINT "press space bar to continue"πEND IFπPAINT (300, 195), 8, 15πPAINT (300, 240), 8, 15πfill0 = 1πLOOPπPUT (180, 179), ded, PSETπCIRCLE (a, b), 40, , , , (2 / 15)πLINE (a + 40, b)-(a + 50, b)πEXIT FORπEND IFπLINE (az - 10, n)-(az - 30, n), 0πaz = az - 5πLINE (az - 10, n)-(az - 30, n), 4πNEXT aaπEND SELECTπEND SELECTπEND IFπIF sfd = 0 THENπRANDOMIZE TIMERπyu = INT(RND * 5) + 1πSELECT CASE yuπCASE 1πCIRCLE (x, y), 10, 0πx = x + 10πCIRCLE (x, y), 10, cxπCASE 2πCIRCLE (x, y), 10, 0πx = x - 10πCIRCLE (x, y), 10, cxπCASE 3πCIRCLE (x, y), 10, 0πy = y - 10πCIRCLE (x, y), 10, cxπCASE 4πCIRCLE (x, y), 10, 0πy = y + 10πCIRCLE (x, y), 10, cxπCASE 5πRANDOMIZE TIMERπaq = INT(RND * ((cx + 10) * 2)) + 1πSELECT CASE aqπCASE 20πsw = xπFOR se = 1 TO 130πIF (sw - 30) <= (a + 50) AND (sw - 30) >= (a - 50) AND y < (b + 20) AND y > (b - 20) THENπlife = life - 1πDOπff = ff + 1πCIRCLE (a, b), ff, 4πLOOP UNTIL ff = 70πff = 80πDOπff = ff - 1πCIRCLE (a, b), ff, 0πLOOP UNTIL ff = 0πGET (180, 179)-(440, 251), dedπLINE (180, 179)-(440, 251), 15, BπLINE (181, 180)-(439, 250), 8, BFπDOπSELECT CASE INKEY$πCASE CHR$(32): fill0 = 0: EXIT DOπCASE "e": GOTO 33πCASE "E": GOTO 33πEND SELECTπLINE (181, 180)-(439, 250), 8, BπIF fill0 = 0 THENπCOLOR 15πLOCATE 13, 30: PRINT "You disappoint me."πLOCATE 15, 26: PRINT "press space bar to continue"πEND IFπPAINT (300, 195), 8, 15πPAINT (300, 240), 8, 15πfill0 = 1πLOOPπPUT (180, 179), ded, PSETπCIRCLE (a, b), 40, , , , (2 / 15)πLINE (a + 40, b)-(a + 50, b)πEXIT FORπEND IFπIF life = 0 THEN GOTO 333πLINE (sw - 10, y)-(sw - 30, y), 0πsw = sw - 5πLINE (sw - 10, y)-(sw - 30, y), 6πNEXT seπEND SELECTπEND SELECTπEND IFπ333 IF life = 0 OR level = 2 THENπ33 CLSπFOR tbg = 1 TO 20πRANDOMIZE TIMERπtbf = INT(RND * 620) + 1πtbd = INT(RND * 460) + 1πtbc = INT(RND * 15) + 1πCIRCLE (tbf, tbd), 10, tbcπNEXT tbgπFOR stb = 1 TO 100πRANDOMIZE TIMERπynh = INT(RND * 630) + 1πyng = INT(RND * 470) + 1πPSET (ynh, yng)πNEXT stbπLOCATE 12, 31: PRINT "G A M E    O V E R !"πLOCATE 15, 30: PRINT "you made it to level"; levelπLOCATE 16, 30: PRINT "your score is"; scoreπSELECT CASE ac2πCASE 0: LOCATE 17, 30: PRINT "accuracy: 0 %"πCASE ELSE: LOCATE 17, 30: PRINT "accuracy:"; CINT((ac1 / ac2) * 100); "%"πEND SELECTπDOπcleer = cleer + 1πSELECT CASE INKEY$πCASE CHR$(32): cleer = cleer - 5πEND SELECTπLOOP UNTIL cleer = 1000πLOCATE 25, 27: PRINT "PRESS SPACE BAR TO CONTINUE"πDOπSELECT CASE INKEY$πCASE CHR$(32)πCLSπPAINT (1, 1), 8πPSET (10, 60): DRAW "r55l55d100u50r50"πPSET (70, 60): DRAW "r50l25d100l25r50"πPSET (125, 60): DRAW "r50d50l50u50d100u50f50"πPSET (180, 60): DRAW "r50l50d50r25l25d50r50"πPSET (330, 60): DRAW "r50l50d50r50d50l50"πPSET (390, 60): DRAW "r50l25d100"πPSET (450, 60): DRAW "r50d100l50u100"πPSET (510, 60): DRAW "r50d50l50u50d100u50f50"πPSET (570, 60): DRAW "d100u100f25e25d100"πLOCATE 17, 30: PRINT "PLAY AGAIN?"πLOCATE 20, 40: PRINT "YES"πLOCATE 23, 40: PRINT "NO"πa = 180: b = 310πCIRCLE (a, b), 40, , , , (2 / 15)πLINE (a + 40, b)-(a + 50, b)πDOπSELECT CASE INKEY$πCASE CHR$(0) + "M" 'rightπCIRCLE (a, b), 40, 8, , , (2 / 15)πLINE (a + 40, b)-(a + 50, b), 8πSELECT CASE bπCASE 310: b = 359πCASE 359: b = 310πEND SELECTπCASE CHR$(0) + "P" 'downπCIRCLE (a, b), 40, 8, , , (2 / 15)πLINE (a + 40, b)-(a + 50, b), 8πSELECT CASE bπCASE 310: b = 359πCASE 359: b = 310πEND SELECTπCASE CHR$(0) + "K" 'leftπCIRCLE (a, b), 40, 8, , , (2 / 15)πLINE (a + 40, b)-(a + 50, b), 8πSELECT CASE bπCASE 310: b = 359πCASE 359: b = 310πEND SELECTπCASE CHR$(0) + "H" 'upπCIRCLE (a, b), 40, 8, , , (2 / 15)πLINE (a + 40, b)-(a + 50, b), 8πSELECT CASE bπCASE 310: b = 359πCASE 359: b = 310πEND SELECTπCASE CHR$(32)πSELECT CASE bπCASE 310: GOTO 34πCASE 359πCLSπLOCATE 10, 36: PRINT "BYE  BYE"πENDπEND SELECTπEND SELECTπCIRCLE (a, b), 40, , , , (2 / 15)πLINE (a + 40, b)-(a + 50, b)πLOOPπEND SELECTπLOOPπEND IFπ321 SELECT CASE INKEY$πCASE CHR$(0) + "M": CIRCLE (a, b), 40, 0, , , (2 / 15): LINE (a + 40, b)-(a + 50, b), 0πa = a + 20: CIRCLE (a, b), 40, , , , (2 / 15): LINE (a + 40, b)-(a + 50, b)πCASE CHR$(0) + "K": CIRCLE (a, b), 40, 0, , , (2 / 15): LINE (a + 40, b)-(a + 50, b), 0πa = a - 20: CIRCLE (a, b), 40, , , , (2 / 15): LINE (a + 40, b)-(a + 50, b)πCASE CHR$(0) + "H": CIRCLE (a, b), 40, 0, , , (2 / 15): LINE (a + 40, b)-(a + 50, b), 0πb = b - 20: CIRCLE (a, b), 40, , , , (2 / 15): LINE (a + 40, b)-(a + 50, b)πCASE CHR$(0) + "P": CIRCLE (a, b), 40, 0, , , (2 / 15): LINE (a + 40, b)-(a + 50, b), 0πb = b + 20: CIRCLE (a, b), 40, , , , (2 / 15): LINE (a + 40, b)-(a + 50, b)πCASE "p"πGET (262, 179)-(363, 251), pazπLINE (262, 179)-(363, 251), 15, BπLINE (263, 180)-(362, 250), 8, BFπDOπSELECT CASE INKEY$πCASE "p": fill0 = 0: EXIT DOπCASE "P": fill0 = 0: EXIT DOπCASE "e": GOTO 33πCASE "E": GOTO 33πEND SELECTπLINE (263, 180)-(362, 250), 8, BπIF fill0 = 0 THENπCOLOR 15πLOCATE 13, 35: PRINT "paused..."πLOCATE 14, 35: PRINT "press p to"πLOCATE 15, 35: PRINT "continue"πEND IFπPAINT (300, 220), 8, 15πfill0 = 1πLOOPπPUT (262, 179), paz, PSETπCASE "P"πGET (262, 179)-(363, 251), pazπLINE (262, 179)-(363, 251), 15, BπLINE (263, 180)-(362, 250), 8, BFπDOπSELECT CASE INKEY$πCASE "p": fill0 = 0: EXIT DOπCASE "P": fill0 = 0: EXIT DOπCASE "e": GOTO 33πCASE "E": GOTO 33πEND SELECTπLINE (263, 180)-(362, 250), 8, BπIF fill0 = 0 THENπCOLOR 15πLOCATE 13, 35: PRINT "paused..."πLOCATE 14, 35: PRINT "press p to"πLOCATE 15, 35: PRINT "continue"πEND IFπPAINT (300, 220), 8, 15πfill0 = 1πLOOPπPUT (262, 179), paz, PSETπCASE CHR$(32)πac2 = ac2 + 1πd = aπFOR r = 1 TO 28π  IF (d + 75) <= (m + 10) AND (d + 75) >= (m - 10) AND b <= (n + 10) AND b >= (n - 10) AND circ = 0 THENπ  ac1 = ac1 + 1π  SELECT CASE vcπ  CASE 0: score = score + 90π  CASE 1: score = score + 75π  CASE 2: score = score + 70π  CASE 3: score = score + 65π  CASE 4: score = score + 60π  CASE 5: score = score + 55π  CASE 6: score = score + 50π  CASE 7: score = score + 45π  CASE 8: score = score + 40π  CASE 9: score = score + 35π  CASE 10: score = score + 30π  CASE 11: score = score + 25π  CASE 12: score = score + 20π  CASE 13: score = score + 15π  CASE 14: score = score + 10π  CASE 15: score = score + 5π  CASE 16: score = score + 5π  END SELECTπ  chang = trueπ  bn = bn + 1π  circ = 1π  DOπ  z = z + 1π  CIRCLE (m, n), z, 4π  LOOP UNTIL z = 25π  z = 27π  DOπ  z = z - 1π  CIRCLE (m, n), z, 0π  LOOP UNTIL z = 0π  LINE (d + 55, b)-(d + 75, b), 0π  EXIT FORπ  ELSEIF (d + 75) <= (x + 10) AND (d + 75) >= (x - 10) AND b <= (y + 10) AND b >= (y - 10) AND sfd = 0 THENπ  ac1 = ac1 + 1π  SELECT CASE cxπ  CASE 0: score = score + 90π  CASE 1: score = score + 75π  CASE 2: score = score + 70π  CASE 3: score = score + 65π  CASE 4: score = score + 60π  CASE 5: score = score + 55π  CASE 6: score = score + 50π  CASE 7: score = score + 45π  CASE 8: score = score + 40π  CASE 9: score = score + 35π  CASE 10: score = score + 30π  CASE 11: score = score + 25π  CASE 12: score = score + 20π  CASE 13: score = score + 15π  CASE 14: score = score + 10π  CASE 15: score = score + 5π  CASE 16: score = score + 5π  END SELECTπ  chang = trueπ  bn = bn + 1π  sfd = 1π  DOπ  z = z + 1π  CIRCLE (x, y), z, 4π  LOOP UNTIL z = 25π  z = 27π  DOπ  z = z - 1π  CIRCLE (x, y), z, 0π  LOOP UNTIL z = 0π  LINE (d + 55, b)-(d + 75, b), 0π  EXIT FORπ  ELSEIF (d + 75) <= (op + 75) AND (d + 75) >= (op - 75) AND b <= (po + 75) AND b >= (po - 75) AND ty < 40 AND bn = 30 THENπ  ac1 = ac1 + 1π  chang = trueπ  gv = (d + 75)π  ty = ty + 1π  score = score + 2π  IF ty = 30 THENπ  chang = trueπ  sfd = 1π  circ = 1π  uj = 0π  score = score + 150π  level = level + 1π  bn = bn + 1π  DOπ  qas = qas + 1π  RANDOMIZE TIMERπ10 ra = INT(RND * (op + 75)) + 1π  IF ra < (op - 75) THEN GOTO 10π11 ar = INT(RND * (po + 75)) + 1π  IF ar < (po - 75) THEN GOTO 11π  DOπ  qaz = qaz + 1π  CIRCLE (ra, ar), qaz, 4π  LOOP UNTIL qaz = 40π  qaz = 42π  DOπ  qaz = qaz - 1π  CIRCLE (ra, ar), qaz, 0π  LOOP UNTIL qaz = 0π  LOOP UNTIL qas = 50π  CIRCLE (op, po), 75, 0π  FOR star = 1 TO 50π    ac = INT(RND * 630)π    ad = INT(RND * 470)π    PSET (ac, ad)π  NEXT starπ  SELECT CASE scoreπ  CASE 900 TO 1099: life = life + 1π  CASE 1100 TO 1300: life = life + 3π  CASE IS >= 1301: life = life + 10π  END SELECTπ  END IFπ  DOπ  yt = yt + 1π  CIRCLE (gv, b), yt, 4π  LOOP UNTIL yt = 20π  yt = 22π  DOπ  yt = yt - 1π  CIRCLE (gv, b), yt, 0π  LOOP UNTIL yt = 0π  LINE (d + 55, b)-(d + 75, b), 0π  EXIT FORπ  END IFπ  LINE (d + 55, b)-(d + 80, b), 0π  d = d + 20π  LINE (d + 55, b)-(d + 80, b), 3πNEXT rπCASE "e": GOTO 33πCASE "E": GOTO 33πEND SELECTπLOOPππJacques Mallah                 JACK'S GAME                    pages.nyu.edu/~jqm1584/        03-06-96 (09:55)       QB, QBasic, PDS        237  13069    JGS.BAS     'JGS.BAS by Jacques MallahπH = 5: RANDOMIZE TIMER: SCREEN 7: L = TIMERπJ: M = M + 1: IF TIMER - L < .4 THEN GOTO JπM = M / 500: X = 2: Y = 10: BX = 38: BY = 10: FC = 16: OXP = -10: OYP = -10πMM = M: ZX = 38: ZY = 2: DIM UA(0 TO 7, 0 TO 7): XP = X * 8 - 4: YP = 76: DIM BA(0 TO 7, 0 TO 7)πDIM A(0 TO 7, 0 TO 7): GOSUB 10: GOSUB 10: BH = 1: LOCATE 1, 1: PRINT "H=  5.00", "S="; S, "BH="; BH: LOCATE 3, 10: PRINT "J A C K 'S  G A M E"πPRINT "KILL THE BAD GUY,   NOW."; : PUT (18 * 8, 24), BAπPRINT "TO SURVIVE MORE SHOTS, PICK UP:": PRINT "H FOR 1 H, "; : COLOR 9: PRINT "H"; : COLOR 15: PRINT " FOR 3 H POINTS."πPRINT "USE CURSOR TO MOVE AND ALMOST ANY OTHER KEY TO SHOOT WHEN "; : COLOR 14: PRINT "-"; : COLOR 15: PRINT " IS WHITE."πLOCATE 12, 1: PRINT "H= # OF HITS YOU CAN TAKE.": PRINT "S= YOUR SCORE": PUT (BX * 8 - 8, BY * 8 - 8), BA: PUT (XP - 4, YP - 4), UA:πLINE (XP + 5, YP)-(XP + 10, YP), 14πPRINT "BH= # OF HITS BAD GUY CAN TAKE.": PRINT "BAD GUYS WOUND YOU AT CLOSE RANGE.": PRINT "H AND "; : COLOR 9: PRINT "H"; : COLOR 15:πPRINT " DON'T MOVE RANDOMLY.": PRINT "YOU CAN TURN AROUND BOUNCING OFF WALLS": PRINT : PRINT "PAUSE PAUSES IT."πPRINT "ON SOME MACHINES, DON'T PRESS KEYS": PRINT "TOO OFTEN, TO AVOID BACKUP.": PRINT "PRESS ONLY ONE KEY AT A TIME."πPRINT "PRESS S FOR SOUND."πTX = 33: TY = 12: LOCATE TY, TX: PRINT "H"; : LOCATE ZY, ZX: COLOR 9: PRINT "H";πCOLOR 15: LOCATE 25, 1: PRINT "PRESS ANY KEY (NOT S) TO START"; : Q = 1: OTY = TY: OTX = TX: OZX = ZX: OZY = ZYπDC = .8 ^ (1 / M): Z = 11 * M ^ 2: NB = M * .14: PS = 1.5 / M: INJ = 1πSS = 3.3 / M: VX = .1 / M: RV = -VX: RR = 1.0013 ^ (1 / M)πIK: I$ = INKEY$: IF I$ = "" THEN GOTO IKπIF UCASE$(I$) <> "S" THEN LINE (XP - 5, YP)-(XP - 10, YP), 0: LINE (0, 176)-(319, 199), 0, BF: GOTO 1πIF SSS = 0 THEN SSS = 1: LOCATE 23, 1: PRINT "PRESS S FOR NO SOUND.": GOTO IKπIF SSS = 1 THEN SSS = 0: LOCATE 23, 1: PRINT "PRESS S FOR SOUND.   ": GOTO IKπG: TX = INT(2 + RND * 36): TY = INT(2 + RND * 21): VTY = 0π1 C = C + PS * .61πIF ZB < TIMER THENπLINE (OBX * 8 - 8, OBY * 8 - 8)-(OBX * 8, OBY * 8), 0, BFπIF Q = 1 THENπIF INJ = 1 THEN PUT (BX * 8 - 8, BY * 8 - 8), BAπELSE Q = 1: CLS : PUT (0, 0), BA: GOSUB Q: GOSUB P: ZB = ZB + 4πEND IFπEND IFπLOCATE OTY, OTX: PRINT " "; : LOCATE OZY, OZX: PRINT " "; : OTY = TY: OTX = TX: OZY = ZY: OZX = ZXπLOCATE 1, 1: PRINT USING "H= ##.##&"; H: LOCATE 1, 15: PRINT "S="; S, "BH="; BHπLOCATE TY, TX: PRINT "H";πLOCATE ZY, ZX: COLOR 9: PRINT "H"; : COLOR 15πIF RV > 2.5 / M THEN VX = VX * 2.5 / RV / M: VY = VY * 2.5 / RV / M: RV = 2.5 / MπI$ = RIGHT$(INKEY$, 1)πON (BZ + Q) GOSUB 200, 200, 200, 210, 220, 230, 240, 250, 250, 250πIF I$ = "H" THEN VY = VY - .08 / NB: GOTO 2πIF I$ = "P" THEN VY = VY + .08 / NB: GOTO 2πIF I$ = "K" THEN VX = VX - .1 / NB: GOTO 2πIF I$ = "M" THEN VX = VX + .1 / NB: GOTO 2πIF I$ = "" THEN 2πIF FC < 33 THENπI$ = INKEY$πELSEπSOUND 450, 1 * SSSπLINE (SX + VSX, SY + VSY)-(SX - VSX, SY - VSY), 0: BS = 0πFC = 0: VSX = VX / RV * 4: VSY = VY / RV * 4: SF = 1: SX = XP: SY = YPπEND IFπ2 R = ((X - BX) ^ 2 + ((Y - BY) * 1.25) ^ 2) ^ .5 + .01πLINE (XP - 4, YP - 4)-(XP + 4, YP + 4), 0, BFπLINE (XP + XPV * 5, YP + YPV * 5)-(XP + VXP * 10, YP + VYP * 10), 0, BFπX = X + VX: IF X < 2 OR X > 38 THEN X = X - VX: VX = -VX * .4: GOSUB DEP: IF VY ^ 2 > .0000001 THEN VY = VY * .3πY = Y + VY: IF Y < 2 OR Y > 23 THEN Y = Y - VY: VY = -VY * .4: GOSUB DEP: IF VX ^ 2 > .0000001 THEN VX = VX * .3πJX = 10000: IF (VX * 10) ^ 2 * M > .0000001 * JY THEN VX = VX * DC: JX = 1πJY = 10000: IF (VY * 10) ^ 2 * M > .0000001 * JX THEN VY = VY * DC: JY = 1πXP = X * 8 - 4: YP = Y * 8 - 4: PUT (XP - 4, YP - 4), UAπRV = ((VX) ^ 2 + (1.25 * VY) ^ 2) ^ .5: FC = FC + SS * .9: IF RV > .4 / M THEN DC = .8 ^ (1 / M) ELSE DC = .6 ^ (1 / M)πVXP = VX / RV: VYP = VY / RV: LINE (XP + VXP * 5, YP + VYP * 5)-(XP + VXP * 10, YP + VYP * 10), 14 - (FC > 32)πIF SF = 1 THENπLINE (SX + VSX, SY + VSY)-(SX - VSX, SY - VSY), 0πDD = (BX * 8 - 4 - SX) * VSX / 4 + (BY * 8 - 4 - SY) * VSY * 1.25 ^ 2 / 4πDE = (BX * 8 - 4 - SX) ^ 2 + ((BY * 8 - 4 - SY) * 1.25) ^ 2 - (DD ^ 2)πIF DD > -6 AND DD < 8 + 3 * 4 * SS AND DE < 75 THENπIF Q = 1 AND TIMER > ZB AND BS = 0 THEN BH = BH - 1: S = S + 2 * BZ + 2: SF = 0: CLS : GOSUB TBASE: BS = 1πIF BH <= 0 THENπBZ = BZ + 1: Q = 0: LINE (BX * 8 - 8, BY * 8 - 8)-(BX * 8, BY * 8), 0, BF: BH = BZ: GOSUB 10: ZB = TIMER + 5: PS = (1.5 + .08 * BH) / M:πVBX = VBX + (RND * 2 - 1) / M: VBY = VBY * (RND * 1.6 - .8) / MπIF BZ = 5 THEN INJ = 1πIF BZ > 4 THEN PS = 2 / MπIF BZ < 8 THEN BX = 38: BY = 2 + RND * 21: VBX = (RND - .5) / M: VBY = (RND - .5) / M ELSE EEP = 1πEND IFπEND IFπSX = SX + VSX * SS * 3: SY = SY + VSY * SS * 3πIF SF = 1 THEN LINE (SX + VSX, SY + VSY)-(SX - VSX, SY - VSY), 13πEND IFπVTY = VTY + .02 / M ^ 2: TY = TY + VTY: IF TY > 23 OR TY < 2 THEN VTY = -VTY: TY = TY + VTYπIF (X - TX) ^ 2 + ((Y - TY) * 1.25) ^ 2 < 1.1 THEN S = S + CINT(BZ / 2) + 1: H = H + 1: GOTO GπVZX = VZX * .99 ^ (1 / M) + (TX - ZX) / 72 / M ^ 2: ZX = ZX + VZXπVZY = VZY * .99 ^ (1 / M) + (TY - ZY) / 90 / M ^ 2: ZY = ZY + VZYπIF ZX + VZX > 38 OR ZX + VZX < 2 THEN VZX = -VZXπIF ZY + VZY > 23 OR ZY + VZY < 2 THEN VZY = -VZYπIF INT(X + .5) = CINT(ZX) AND INT(Y + .5) = INT(ZY + .5) THEN S = S + CINT(BZ / 2) + 1: H = H + 3: ZX = 38: ZY = 2: VZY = 0: VZX = -RND * 3 / MπIF Q = 0 OR TIMER < ZB THEN GOTO BπVBX = VBX * .9 ^ (1 / M) + (X - BX) / R / Z + (RND - .5) / Z * 1.9πVBY = VBY * .9 ^ (1 / M) + (Y - BY) / Z / 1.25 / R + (RND - .5) / Z * 1.52πIF BX + VBX > 38 OR BX + VBX < 2 THEN VBX = -VBXπIF BY + VBY > 24 OR BY + VBY < 2 THEN VBY = -VBYπOBX = BX: OBY = BY: BX = BX + VBX: BY = BY + VBYπIF INT(X + .5) = INT(.5 + BX) AND INT(Y + .5) = INT(BY + .5) THEN H = H - .4 / M: LINE (0, 0)-(319, 199), 4, BF: CLSπB: IF C <= 14 THEN GOTO SMπIF Q = 1 AND TIMER > ZB THENπSOUND 750, 1 * SSSπEEP = 0: LINE ((FX + VFX) * 8 - 4, (FY + VFY) * 8 - 4)-((FX - VFX) * 8 - 4, (FY - VFY) * 8 - 4), 0πFX = BX: FY = BY: RVF = (((X - BX) + VX * R / PS / 3) ^ 2 + (((Y - BY) + VY * R / PS / 3) * 1.25) ^ 2) ^ .5πVFX = ((X - BX) + VX * R / PS / 3) / 2 / RVF: VFY = ((Y - BY) + VY * R / PS / 3) / 2 / RVF: C = 0: F = 0πELSEπF = 1πEND IFπSM: DD = (X - FX) * VFX * 2 + (Y - FY) * VFY * 1.25 ^ 2 * 2πDE = (X - FX) ^ 2 + (Y - FY) ^ 2 * 1.25 ^ 2 - (DD ^ 2)πLINE ((FX + VFX) * 8 - 4, (FY + VFY) * 8 - 4)-((FX - VFX) * 8 - 4, (FY - VFY) * 8 - 4), 0πIF DD > -.5 AND DD < .5 + 3 * .5 * PS AND DE < .8 AND F = 0 THEN H = H - 1: F = 1: TFK = TIMER + 1: LINE (0, 0)-(319, 199), 4, BF: GOSUB TBASE: CLS : IF ZB > TIMER THEN LOCATE 3, 1: PRINT "BAD GUY:": PRINT F$πFX = FX + VFX * PS * 3: FY = FY + VFY * PS * 3πIF F = 0 THEN LINE ((FX + VFX) * 8 - 4, (FY + VFY) * 8 - 4)-((FX - VFX) * 8 - 4, (FY - VFY) * 8 - 4), 4πS = S * RR: IF H > 0 THEN 1πCLSπ3 GOSUB DEP: S = INT(S): COLOR 15: GOTO 50π7 CLS : PP = 0: IF BH < 9 THEN PRINT "ENTER S TO SEE HIGH SCORES"πPRINT "S ="; S: PP = 0: INPUT "ANOTHER GAME(Y/DEFAULT = NO)"; Y$πIF Y$ = "Y" OR Y$ = "y" THEN CLS : RUNπIF (Y$ = "S" OR Y$ = "s") AND BH < 9 THEN 51πENDπDEP:  I$ = INKEY$: IF I$ <> "" THEN GOTO DEPπSOUND 600, 1 * SSS: RETURNπTBASE: FOR T = 1 TO 90 * (M - 1): NEXT: SOUND 300, 1 * SSS: RETURNπQ: IF BZ > 7 THEN RETURNπFOR C = 0 TO 7: FOR T = 0 TO 7: A(C, T) = POINT(C, T): NEXT: NEXTπFOR N = 1 TO 6 STEP 1 / MMπFOR C = 0 TO 7: I$ = INKEY$: FOR T = 0 TO 7πLINE (C * N, T * N)-(C * N + N - 1, T * N + N - 1), A(C, T), BFπNEXT: NEXT: NEXT: GOSUB DEP: CLS : RETURNπP: IF BZ < 9 AND Q = 0 THEN READ F$πIF BZ = 0 THEN LOCATE 9, 1: PRINT F$πIF BZ < 9 AND BZ <> 0 THEN LOCATE 3, 1: PRINT "BAD GUY:": PRINT F$πIF BZ = 9 THEN LOCATE 4, 1: PRINT "IF YOU DISPEL ITS FORM A THIRD TIME": PRINT "IT WILL BE BANISHED"πRETURNπ10 IF BZ > 1 THEN BH = BH - 1: IF BH > 6 THEN BH = 6πIF BZ = 2 THEN RETURNπIF BZ = 10 THEN 15πIF BZ < 8 THEN READ F1, F2, F3, F4: LOCATE 1, 1: PRINT " "πLINE (3, 0)-(4, 1), F1, B: LINE (7, 5)-(7, 5), F1: LINE (0, 5)-(0, 5), F1πLINE (1, 2)-(6, 2), F2: LINE (3, 3)-(4, 4), F2, B: LINE (0, 3)-(0, 4), F2πLINE (7, 3)-(7, 4), F2: LINE (3, 5)-(2, 6), F3: LINE (4, 5)-(5, 6), F3πLINE (0, 7)-(1, 7), F4: LINE (6, 7)-(7, 7), F4πIF AU = 0 THEN GET (0, 0)-(7, 7), UA: AU = 1: GOSUB Q: GOSUB P: RETURNπGET (0, 0)-(7, 7), BA: IF BZ = 0 THEN GOSUB QπGOSUB P: RETURNπDATA 6,9,1,8,,6,8,8,8,"THE BAD GUY NOW IS A SECURITY GUARD",6,2,2,2,"ARMY GUY",6,6,15,6,"KARATE MASTER - STUN SHOTS"πDATA 6,0,0,0,"NINJA - INVISIBILITY",8,8,8,8,"ROBOT - HEAT SEEKING SHOTS",8,2,2,2,"ARMY ROBOT - EXPLOSIVE SHOTS",4,4,4,4,"DEMON - CAN TELEPORT"πDATA "CAN IT BE DEAD?"π15 S = S * 1.5: PAINT (100, 100), 5, 12: COLOR 0πFOR T = 0 TO 6000 * M STEP 9: A = T * ATN(1) / 180 * 4: R = T / 30πIF T > 33000 THEN FOR JH = 1 TO M * 10000: NEXT: EXIT FORπLINE (150 - R * COS(A), 95 - SIN(A) * R * .8)-(150 + R * .25, 95 - R * .25)πNEXT: DIM LX(-1 TO 1, -1 TO 1): DIM LY(-1 TO 1, -1 TO 1): X = 20: Y = 27πDIM VLX(-1 TO 1, -1 TO 1): DIM VLY(-1 TO 1, -1 TO 1): SCREEN 0πFOR C = 9 TO 15: COLOR CπEX = 0: VS = -.83 - RND / 7: X = 17 + 6 * RNDπFOR T = -1 TO 1: FOR A = -1 TO 1: VLY(T, A) = VS: VLX(T, A) = 0πLX(T, A) = X: LY(T, A) = Y: NEXT: NEXTπ20 FOR T = -1 TO 1: FOR A = -1 TO 1πIF LX(T, A) > .5 AND LX(T, A) < 40 AND LY(T, A) > .5 AND LY(T, A) < 25 THENπFOR R = 0 TO M: LOCATE LY(T, A), LX(T, A): PRINT "`"; : NEXTπEND IFπVLY(T, A) = VLY(T, A) + .02: LY(T, A) = LY(T, A) + VLY(T, A): LX(T, A) = LX(T, A) + VLX(T, A)πIF LX(T, A) > .5 AND LX(T, A) < 40 AND LY(T, A) > .5 AND LY(T, A) < 25 THENπFOR R = 0 TO M: LOCATE LY(T, A), LX(T, A): PRINT "*"; : NEXTπEND IFπNEXT: NEXTπIF VLY(0, 0) > 0 AND EX = 0 THENπEX = 1: FOR T = -1 TO 1: FOR A = -1 TO 1πR = 1.5 / (3 + 3 * RND): VLX(T, A) = T * R: VLY(T, A) = VLY(T, A) + A * R: NEXT: NEXTπEND IFπIF LY(-1, -1) < 26 OR EX = 0 OR LY(1, -1) < 26 THEN GOTO 20πLOCATE 1, 1: COLOR 0: PRINT " ": LOCATE 1, 1: SLEEP 1: CLSπNEXTπLOCATE 1, 1: PRINT "YOU WON": PRINT : GOTO 3π50 DIM N$(1 TO 10): DIM S$(1 TO 10): DIM S(1 TO 10)πSCREEN 8: ON ERROR GOTO 100π51 OPEN "SDF.12" FOR INPUT ACCESS READ AS #1πFOR T = 1 TO 10: LINE INPUT #1, N$(T): LINE INPUT #1, S$(T)πS(T) = VAL(S$(T)): NEXT: CLOSE #1πIF S <= S(10) AND Y$ <> "S" AND Y$ <> "s" THEN GOTO CLπIF UCASE$(Y$) = "S" THEN 52πPP = 0: FOR T = 10 TO 1 STEP -1: IF S > S(T) THEN PP = TπNEXTπ52 CLS : PRINT "#", "NAME", , , "SCORE": PUT (88, 0), UAπFOR T = 10 TO 2 STEP -1: IF PP < T AND UCASE$(Y$) <> "S" THEN N$(T) = N$(T - 1): S(T) = S(T - 1): S$(T) = STR$(S(T))πNEXT: FOR T = 1 TO 10: LOCATE T + 1, 1: PRINT T, : IF T <> PP THEN PRINT N$(T) ELSE PRINT "   {You}"πLOCATE T + 1, 56: IF T <> PP THEN PRINT S$(T) ELSE PRINT SπNEXT: IF UCASE$(Y$) = "S" THEN GOTO 101πKILL "SDF.12"π100  IF ERR > 0 THEN PP = 1: CLOSE #1πIF S < 1 THEN BH = 10: GOTO CLπIF PP < 1 THEN GOTO CLπPRINT : PRINT "S ="; S: GOSUB DEPπINPUT "NAME? ", N$(PP): IF LEN(N$(PP)) > 40 THEN N$(PP) = LEFT$(N$(PP), 40)πS(PP) = S: S$(PP) = STR$(S)πOPEN "SDF.12" FOR OUTPUT ACCESS WRITE AS #1πFOR T = 1 TO 10: PRINT #1, N$(T): PRINT #1, S$(T): NEXTπGOSUB DEP: FOR T = 1 TO 15000 * M: NEXTπCL: CLOSE #1π101 IF Y$ = "S" OR Y$ = "s" THENπPRINT : INPUT "ELIMINATE CURRENT LIST (YES/DEFAULT = NO)?", Y$πIF UCASE$(Y$) = "YES" THEN KILL "SDF.12": BH = 10: OPEN "SDF.12" FOR OUTPUT ACCESS WRITE AS #1: FOR T = 10 TO 100 * RND + 20: PRINT #1, "@"; : NEXT: CLOSE #1πEND IFπGOTO 7π200 RETURNπ210 IF TFK > TIMER THEN KM = 1 ELSE KM = 0πLINE (OXP - 8, OYP + 8)-(OXP + 7, OYP + 8), 0πIF KM = 1 THEN I$ = INKEY$: I$ = "": KM = 0: LINE (XP - 8, YP + 8)-(XP + 7, YP + 8), 7: OXP = XP: OYP = YPπRETURNπ220 IF BZ = 5 THEN RETURNπIF Q = 0 OR ZB > TIMER THEN INJ = -1: RETURNπIF TB < TIMER THEN TB = TIMER + 3 + INJ / 2: INJ = -INJπRETURNπ230  IF F = 1 OR C > 14 THEN RETURNπDD = (X - FX) * VFX * 2 + (Y - FY) * VFY * 1.25 ^ 2 * 2 + .001πRUF = ((X - FX) ^ 2 + (Y - FY) ^ 2 * 1.25 ^ 2) ^ .5 + .001πRF = 42 * (DD) ^ 2 ^ .5 / RUF * MπLINE ((FX + VFX) * 8 - 4, (FY + VFY) * 8 - 4)-((FX - VFX) * 8 - 4, (FY - VFY) * 8 - 4), 0πVFX = VFX + (X - FX) / RF: VFY = VFY + (Y - FY) / RF / 1.25πRF = (VFX ^ 2 + (VFY ^ 2 * 1.25 ^ 2)) ^ .5: VFX = VFX * .5 / RF: VFY = VFY * .5 / RFπC = C - PS * .2πLINE ((FX + VFX) * 8 - 4, (FY + VFY) * 8 - 4)-((FX - VFX) * 8 - 4, (FY - VFY) * 8 - 4), 4πRETURNπ240 IF F = 1 OR EEP = 1 OR C > 14 THEN RETURNπIF FX < 1 THEN EX = 0: EY = FY * 8 - 1: EEP = 1πIF FX > 40 THEN EX = 319: EY = FY * 8 - 1: EEP = 1πIF FY < 1 THEN EY = 0: EX = FX * 8 - 1: EEP = 1πIF FY > 25 THEN EY = 199: EX = FX * 8 - 1: EEP = 1πIF EEP = 0 THEN RETURNπIF EX < 0 THEN EX = 0πIF EX > 319 THEN EX = 319πIF EY < 0 THEN EY = 0πIF EY > 199 THEN EY = 199πCIRCLE (EX, EY), 69, 4: PAINT (EX, EY), 4, 4: GOSUB TBASE: PAINT (EX, EY), 0, 0: CIRCLE (EX, EY), 69, 0πIF (X * 8 - 4 - EX) ^ 2 + (Y * 8 - 4 - EY) ^ 2 * 1.25 ^ 2 < 70 ^ 2 THEN H = H - 1πRETURNπ250 IF EEP = 1 THEN RETURNπEEP = 1: PLZ = PLZ + 1: IF PLZ < 6 THEN RETURNπPLZ = 0: LINE (BX * 8 - 8, BY * 8 - 8)-(BX * 8, BY * 8), 0, BFπBX = 2 + RND * 36: BY = 2 + RND * 21: RETURNππJacques Mallah                 COMBAT GAME                    pages.nyu.edu/~jqm1584/        03-06-96 (09:55)       QB, QBasic, PDS        160  7993     COMBAT.BAS  DECLARE SUB PRNTM (MX!, MY!) : 'CB2.BAS by Jacques MallahπDECLARE SUB MAPMAK () : DECLARE FUNCTION D (N, T, P) : RANDOMIZE TIMERπMXMN = 10: DIM MAP(1 TO 80, 1 TO 23): X = D(1, 80, 0): Y = D(1, 23, 0)πX = 1: Y = 13: '                Kill 10 monsters to winπDIM MLX(-1 TO 14), MLY(-1 TO 14): FOR TE = 1 TO 75πMAP(D(1, 80, 0), D(1, 23, 0)) = 11: NEXTπFOR M = 1 TO 80: MAP(M, 10) = 13: MAP(M, 15) = 13: NEXTπFOR M = 1 TO 10: MAP(26, M) = 13: NEXTπFOR M = 15 TO 23: MAP(26, M) = 13: MAP(55, M) = 13: NEXTπMAP(13, 10) = 11: MAP(14, 10) = 11: MAP(13, 15) = 11: MAP(14, 15) = 11πMAP(40, 10) = 11: MAP(41, 10) = 11: MAP(40, 15) = 11: MAP(41, 15) = 11πMAP(66, 10) = 11: MAP(67, 10) = 11: MAP(66, 15) = 11: MAP(67, 15) = 11πMAP(X, Y) = -1: FOR M = 1 TO MXMNπMP: MX = D(1, 80, 0): MY = D(1, 23, 0): IF MAP(MX, MY) <> 0 THEN GOTO MPπMAP(MX, MY) = M: MLX(M) = MX: MLY(M) = MY: NEXTπHPT1 = 25: THAC01 = 13: AC1 = 1: ATT1 = 1: DDN1 = 1: DDT1 = 8: DDP1 = 1πST1 = 7: HP1 = HPT1: ITEM$(1) = "(P)OTION OF EXTRA HEALING": ITN(1) = 2πITEM$(2) = "(G)RENADE": ITN(2) = 1πITEM$(3) = "(S)TRENGTH POTION": ITN(3) = 1πITEM$(4) = "(C)ALTROP DETECTION POTION": ITN(4) = 1πITEM$(5) = "(A)DDED TOTAL HP POTION": ITN(5) = 0: IT1 = 5π1 : MAPMAK: CLS : RN = 0: IF MN = 12 GOTO 24πRESTORE: FOR M = 1 TO MNπREAD N2$, HD2, HDP2, THAC02, AC2, ATT2, DDN2, DDT2, DDP2, ST2, SP$, TR: NEXTπIF OHPT2(MN) = 0 THEN HPT2 = D(HD2, 8, HDP2): HP2 = HPT2: OHPT2(MN) = HP2 ELSE HP2 = HP2(MN): HPT2 = OHPT2(MN)π10 RN = RN + 1: PRINT : PRINT "Round "; RN: PRINT "1:FIGHTER", "HP1="; HP1; "/"; HPT1πPRINT "2:"; N2$: ', "HP2="; HP2; "/"; HPT2π11 PRINT "#1 ACTION:(R)UN,(I)TEM,(SPACE OR ENTER)=FIGHT"π12 I$ = UCASE$(INPUT$(1))πIF I$ <> " " AND I$ <> "R" AND I$ <> "I" AND I$ <> CHR$(13) THEN 12πIF I$ = "I" THEN GOSUB ITEM: IF IT$ = "" THEN 11πI1 = D(1, 6, 0): I2 = D(1, 6, 0): I = 0πIF I1 > I2 THEN I = 1: PRINT "1 HAS INIT.": GOSUB A1: IF I$ = "R" GOTO 23πIF I1 > I2 AND HP2 > .1 THEN GOSUB A2πIF HP1 < 1 GOTO 21πIF HP2 < 1 GOTO 22πIF I2 > I1 THEN I = 2: PRINT "2 HAS INIT.": GOSUB A2: IF HP1 > .1 THEN GOSUB A1: IF I$ = "R" GOTO 23πIF HP1 < 1 GOTO 21πIF HP2 < 1 GOTO 22πIF I = 0 THEN PRINT "SIMULTANEOUS INIT.": GOSUB A1: IF I$ = "R" GOTO 23πIF I = 0 THEN GOSUB A2πIF HP1 < 1 AND HP2 < 1 GOTO 20πIF HP1 < 1 GOTO 21πIF HP2 < 1 GOTO 22πGOTO 10π20 PRINT "BOTH 1 AND 2 ARE DEAD": PRINT : PRINT "SCORE:"; S: PRINT : ENDπ21 PRINT "HP2="; HP2; "/"; HPT2, , "1 IS DEAD": PRINT : PRINT "SCORE:"; S: PRINT : ENDπ22 PRINT "HP1="; HP1; "/"; HPT1, , "2 IS DEAD": SPB = 0: MNK = MNK + 1: S = S + 20 + 10 * HD2π23 IF TR > 0 AND I$ <> "R" THEN PRINT "U FIND A "; ITEM$(TR): ITN(TR) = ITN(TR) + 1πIF MNK = MXMN THEN PRINT : PRINT "U WIN": PRINT "SCORE:"; S + HP1 * 2 + 30: PRINT : ENDπ25 PRINT "#1 ACTION:(I)TEM,OTHER=CONTINUE": I$ = UCASE$(INPUT$(1))πIF I$ <> "I" THEN 1π24 GOSUB ITEM: IF IT$ = "" THEN 1πIF IT$ = "P" THEN PRINT "1 USES "; ITEM$(1): HP1 = HP1 + D(3, 8, 3): S = S - 20: IF HP1 > HPT1 THEN HP1 = HPT1πIF IT$ = "G" THEN PRINT "1 WASTES "; ITEM$(2): S = S - 50πIF IT$ = "S" THEN PRINT "1 WASTES "; ITEM$(3): S = S - 50πIF IT$ = "C" THEN PRINT "1 USES "; ITEM$(4): CLDT = 1: CLT = TIMER: S = S - 20πIF IT$ = "A" THEN PRINT "1 USES "; ITEM$(5): HPT1 = HPT1 + D(1, 6, 0)πPRINT "HP1="; HP1; "/"; HPT1: PRINT : GOTO 25πA1: IF I$ = "R" THEN PRINT "#1 HAS FLOWN LIKE A CHICKEN.": X = OX: Y = OY: HP2(MN) = HP2: GOTO 31πIF I$ = "I" GOTO 31πH = D(1, 20, AC2): IF H - AC2 = 20 THEN H = H + 5πIF H - AC2 = 1 THEN H = 0πIF H >= THAC01 THENπDAM = D(DDN1, DDT1, DDP1 + SPB): IF SP$ = "1/2" THEN DAM = CINT(DAM / 2)πHP2 = HP2 - DAM: PRINT "1'S ATT HIT"πEND IFπ31 IF I$ = "I" THENπIF IT$ = "P" THEN PRINT "1 USES "; ITEM$(1): S = S - 20: HP1 = HP1 + D(3, 8, 3): IF HP1 > HPT1 THEN HP1 = HPT1πIF IT$ = "G" THEN PRINT "1 USES "; ITEM$(2): HP2 = HP2 - D(3, 6, 0): S = S - 20πIF IT$ = "S" THEN PRINT "1 USES "; ITEM$(3): SPB = 6: S = S - 20πIF IT$ = "C" THEN PRINT "1 WASTES "; ITEM$(4): S = S - 50πIF IT$ = "A" THEN PRINT "1 USES "; ITEM$(5): HPT1 = HPT1 + D(1, 6, 0)πEND IFπRETURNπA2: H = D(1, 20, AC1): IF H - AC1 = 20 THEN H = H + 5πIF H - AC1 = 1 THEN H = 0πIF H >= THAC02 THENπHP1 = HP1 - D(DDN2, DDT2, DDP2): PRINT "2'S ATT HIT"πIF SP$ = "POI" AND D(1, 20, 0) < ST1 THEN PRINT "1 IS POISONED!": HP1 = -10πIF SP$ = "REG" THEN HP2 = HP2 + 3: IF HP2 > HPT2 THEN HP2 = HPT2πEND IFπRETURNπ'N2$, HD2, HDP2, THAC02,AC2, ATT2, DDN2, DDT2, DDP2, ST2, SP$,TRπDATA OGRE,4,1,12,3,1,1,10,0,11,,1πDATA HOBGOBLIN,1,1,14,5,1,1,8,0,11,,3πDATA SKELETON,1,0,15,5,1,1,8,0,11,1/2,2πDATA HUGE SPIDER,2,2,14,5,1,1,6,0,11,POI,3πDATA SKELETON,1,0,15,5,1,1,8,0,11,1/2,5πDATA RAT,0,1,16,7,1,0,0,1,11,,4πDATA HUGE SPIDER,2,2,14,5,1,1,6,0,11,POI,2πDATA RAT,0,1,16,7,1,0,0,1,11,,2πDATA RAT,0,1,16,7,1,0,0,1,11,,1πDATA TROLL,6,3,11,4,1,2,8,0,11,REG,2πITEM: PRINT "1 HAS THESE ITEMS:"πFOR II = 1 TO IT1: IF ITN(II) > 0 THEN PRINT ITEM$(II); " x"; ITN(II)πNEXT: PRINT "OTHER:DON'T USE ITEM": IT$ = UCASE$(INPUT$(1))πIF IT$ = "P" THEN IF ITN(1) > 0 THEN ITN(1) = ITN(1) - 1 ELSE IT$ = ""πIF IT$ = "G" THEN IF ITN(2) > 0 THEN ITN(2) = ITN(2) - 1 ELSE IT$ = ""πIF IT$ = "S" THEN IF ITN(3) > 0 THEN ITN(3) = ITN(3) - 1 ELSE IT$ = ""πIF IT$ = "C" THEN IF ITN(4) > 0 THEN ITN(4) = ITN(4) - 1 ELSE IT$ = ""πIF IT$ = "A" THEN IF ITN(5) > 0 THEN ITN(5) = ITN(5) - 1 ELSE IT$ = ""πIF IT$ <> "P" AND IT$ <> "S" AND IT$ <> "G" AND IT$ <> "C" AND IT$ <> "A" THEN IT$ = ""πRETURNππFUNCTION D (N, T, P)πFOR C = 1 TO N: S = S + INT(RND * T + 1): NEXTπD = S + PπEND FUNCTIONππSUB MAPMAKπSHARED MAP(), X, Y, MN, OX, OY, HP1, HPT1, CLDT, CLT, S, MLX(), MLY(), MXMNπSM: CLS : MN = 0: MAP(X, Y) = -1: FOR MX = 1 TO 80: FOR MY = 1 TO 23: IF MAP(MX, MY) = 0 GOTO STMπIF CLDT = 1 AND MAP(MX, MY) = 11 THEN LOCATE MY, MX: PRINT "."; : GOTO STMπIF MAP(MX, MY) = 13 THEN LOCATE MY, MX: PRINT "["; : GOTO STMπIF MAP(MX, MY) > 0 AND MAP(MX, MY) < 11 THEN PRNTM MX, MY: GOTO STMπIF MAP(MX, MY) < 0 THEN LOCATE MY, MX: PRINT "U";πSTM: NEXT: NEXT: MC = 1πLP: I$ = UCASE$(RIGHT$(INKEY$, 1))πIF CLDT = 1 AND TIMER - 50 > CLT THEN CLDT = 0: GOTO SMπLOCATE 24, 1: PRINT "HP1 / HPT1 ="; HP1; "/"; HPT1; , "(I)TEM; MOVE:CRSR";πLOCATE 24, 60: PRINT "SCORE:"; S; : TIM = TIMERπIF TIM <> OTIM AND I$ = "" THENπXS = MLX(MC): YS = MLY(MC): MC = MC + 1: IF MC > MXMN THEN MC = 1πXS2 = XS: YS2 = YS: IF X > XS THEN XS2 = XS + 1πIF Y > YS THEN YS2 = YS + 1πIF X < XS THEN XS2 = XS - 1πIF Y < YS THEN YS2 = YS - 1πIF MAP(XS2, YS2) < 11 THENπLOCATE YS, XS: PRINT " "; : LOCATE YS2, XS2: PRINT " ";πMLX(MAP(XS, YS)) = XS2: MLY(MAP(XS, YS)) = YS2πMAP(X, Y) = 0: MM = MAP(XS2, YS2): MAP(XS2, YS2) = MAP(XS, YS): MAP(XS, YS) = MMπIF MAP(X, Y) = 0 THEN MAP(X, Y) = -1πIF MAP(XS, YS) > 0 THEN PRNTM XS, YS: OX1 = XS: OY1 = YSπIF MAP(XS2, YS2) > 0 THEN PRNTM XS2, YS2: OX1 = XS: OY1 = YSπIF MAP(XS, YS) = -1 THEN LOCATE YS, XS: PRINT "U";πIF MAP(XS2, YS2) = -1 THEN LOCATE YS2, XS2: PRINT "U";πIF MAP(X, Y) > 0 THEN I$ = " ": OOO = 1πEND IFπEND IFπOTIM = TIM: IF I$ = "" THEN GOTO LPπLOCATE Y, X: PRINT " "; : OX = X: OY = YπIF I$ = "H" AND Y > 1 THEN MAP(X, Y) = 0: Y = Y - 1πIF I$ = "P" AND Y < 23 THEN MAP(X, Y) = 0: Y = Y + 1πIF I$ = "K" AND X > 1 THEN MAP(X, Y) = 0: X = X - 1πIF I$ = "M" AND X < 80 THEN MAP(X, Y) = 0: X = X + 1πIF I$ = "I" THEN MN = 12πIF MAP(X, Y) <= 0 THEN MAP(X, Y) = -1: LOCATE Y, X: PRINT "U";πIF MN = 11 THEN LOCATE 25, 1: PRINT "                         "; : MN = 0πIF MN < 12 THEN IF MAP(X, Y) > 0 THEN MN = MAP(X, Y) ELSE GOTO LPπIF MN = 11 THEN LOCATE 25, 1: PRINT "U STEPPED ON TETSU-BISHI."; : HP1 = HP1 - 1: MAP(X, Y) = -1: LOCATE Y, X: PRINT "U"; : IF HP1 > .1 THEN GOTO LP ELSE LOCATE 25, 40: PRINT "1 IS DEAD!"; : ENDπIF MN = 13 THEN X = OX: Y = OY: MN = 0: LOCATE Y, X: PRINT "U"; : GOTO LPπIF OOO = 1 THEN OOO = 0: OX = OX1: OY = OY1πEND SUBππSUB PRNTM (MX, MY)πSHARED X, YπIF (X - MX) ^ 2 + (Y - MY) ^ 2 < 26 THEN LOCATE MY, MX: PRINT "M"πEND SUBππMike Hulme & Co.               SPHERE FIGHTER                 [e-mail]    03-08-96 (08:33)       QB, QBasic, PDS        308  20109    SPHRFITE.BAS'[--------------- PRODUCT OF >>>>>>> MAVERICK PROGRAMMING ---------------]π' [.................... Sphere Fighter, Version 1.7 ....................]π'     [............... *NOT RECOMMENDED FOR WINDOWS* ...............]π'                       ~~~~~~~~~~~~~~~~~~~~~~~~~~~π' Requirements:π'  1. 10k free memory (WOW, that's a lot!) ***SEE <FILE NOTES>  ***π'  2. VGA or MCGA adapter (SCREEN 13)π'  3. Mouse (one button only)π'  4. uses Sound Card for SFX and MUSIC!!π'  5. 386 PC or higher recommendedπ'     a. To adjust Computer's speed, use > (slow game down), or < (faster)π'  6. *WARNING*  This program pushes computer memory to the limit...ππDEFINT A-Z:DIM SHARED K,S,B&,Z&:V1 'Created by PostIt! 7.2πSUB V1:OPEN "O",1,"SPFIGHT.ZIP",4^6:Z&=14325:?STRING$(50,177);πU"%up()%9%%%.-%Gf/7Esz7>[=Xd%%vc%%%1%%%%xu%mwkn%yjSgRfxfLq*FSAZKaπU"TH<i)w&Z$&F]RL]?]9M7PndW0S)8h=i+tkQrGb4BETWe/]\miSX<QwfvzW3*ce.πU")]bq?G7QXU&x4yr3y33<s%Vacx(Hv)^k4,0f06qR+BkUix$-l8l$e_S>Fh3uQenπU"3fv8a;?tX4$6HBNBl$u$Jr<l8mLn6EJ=<rD7bH$T<b()E_;#d]F7ENqp\bHTs\RπU"V>3WGoPB<t<0rC_RFH?Xf0,]hlTK$-1WRr8N%xg(spxlpN;b6XtZM\;E:l;gg?lπU"YA,mL>AhX,lD(sq>Mi7iAq$TIdC7^EVR7hOW5Gj1?]3]z;vJ_7H?%$IFhwLs.G:πU"Iq*WlYnB)IbV_LJxhOFkfsg]AU'KTLuD;O/OVfb*zIjL>/Z,bdz9%*07Qi_.H/JπU"Lq'5Rmk:9dVJ]0)ka#k>AM2IRCpa,t[3GWLCQe^JXzz_nB,C5tjVW*<KewI316qπU"rEvxy_8Fq?&P2$>z#UGs?Qx)1;:Vx;,NXneo4YkU9W<Hih<UIpc/h+n<d,JoreYπU"9>5e_fBOsO#]>ut_)X<fn5E)3K\0cB<W1q,Ip]80:WVeuLQ3EM19_caGLl-RvQ_πU".cc5yMO_5(G_Y)Zn7>E<s+b(go(>s2p\LR8Wa$,P*le1_mBSCrFjX^4D39^DcwtπU"jhVkk2lljD0pW]CEoGy]JxYB=0,B$RpptH?K709abhY]G3<2&v2X._:m$[cB3W9πU",I0dqEV]v,l8%P#EpUL?+i8ipE?ii75QujUiY:aeK2%H3$BAd70h'hE[k[V#LSHπU"1Ad]*^uE6^&:tu,UBk;8nY+tJ6qn4UiI;:aq8FB%GIwTbV0R<NS(Nl\T7keaAPyπU"cPvk,m4cgJsMZ>xgA&]'<x%p2w]UY9arZOzAzXb?Wkw$Uni,o>Rb&6;Rsi,q(4cπU"^V^Q-NBJm5cYDGY9hAtGHmBb)lreUE%GW0nJG<K-Tu/hZjE[5p6JxIB5GDxYk[GπU";g_bM5rB9*Lst(R6p*J^>IG[4t[W#1nOfE;0-/+fZK(\[km2K>AlH1SOc2+N\ibπU"i9AX#fxT)1,k62rbb8mS=f]y)0sVZ8=;7d+z1>,c]SLP1&2No;=e:b(.pZVQatVπU"WeGFhGbewI;J5&3oXqID;76X^(iDnKG8]qvA=-o9>S$n)W35(;A,3cjC<\pLbpVπU"^TFjVrT)Il/^(JUH,LnR*2x4oGl7?j_pfd=6bUfH;zA4L:Q\QT9jQsG5>eiWZ5:πU"Sqiu7C'm_kLQLN$XNZW.sK]T,6b[Hi2=KNs6_,^cMXe.Pe)9_HH:kHPu3jAF/9cπU"6gCrLYqTR2rK:\jUn$j1Dx0R0PP8m>G='qPUe9hHkl_q(Ypp*&a2LMHgJG.vJa8πU"5a66Gcsu6Z]ufVBg^p4i>HZ(EYUdJ\ZM)O(gNVJBpcfNiN4k'K_xw&:K-]X25TCπU"T8-5#(<joFWbO2\r4m'RT8Mm5J_I=K:V9Xc=U\JxF+4w)4#Lfief7\6iCpNoQdtπU"cGhe_]FD8(=VX.ndH8'M\hC05R$Ul9wPUd)PwiB(F.oRvJ%kX[#gW.9erQ>VtW'πU"]t3hhbe*ECnLcmhH6^lNWskUJ/N(n6(Qp9I=,nf1fSS%<K.DP<7VVuJd/]*UKkKπU"ICpiIV07S^6]cd2JKR(RwDE^VmvF)60EezJA7s1'$wLbJAVH<:U0l_qGqN'B9isπU"rJ_B3<#G1Lb?JO9G9u'ZS<$(&C,7Z1l>0e-Kb3lrY]X4uHHGAW1HoeLY*RZjVb]πU"B?qMfD-#/'BQjQ^ec,i-V=:q45CZ'GFtz4Xo$QN.)nDqWtfln?hZDWc54:&ecOMπU">iaV%BMDPO=;#SJqA8ri(Q=NP/TEB%2he(fS:l&50I[j0pM\Tx6K+Fe<4%30FoDπU"Z0PemM$J.0]TcKFuo4'\X[1ld&\/ocmc;cb\DT6cG[ugk?:>BN(>,2TuGpoo?AtπU"LfL8\;FGvf_6*Fppk7<RK.SoTkmYdA^MVX+*NG0]d+MY>GFj+ernrjEC7:kFWYQπU"q5NoTL]p%dFNmp.k,sfEM[vzihNX924b1/;6CvSegrKmNb'KZrvBQ8co,9]<RoRπU"C3.Is]F?mtmhtZ74,6FPws1(T\'6q6H8NVfS\='wuU)Tfdn/5ppPd8gK>4H:I9kπU"cr^n'vi9nHk%-W-rO7.a]6'D4Sb6?%91TgP;:]uwn;f^$=;&WPKdqtGZnv6Fu(.πU"MJz8)(.k]%(b3yUT3C%qEl/>$=G-RbCE#83uRgo4o\A/V,#0d?I4TI=&NQjSXfHπU"*.mamJYN5EP\Y(EdA+*61%nvM05o>RFa7'l0hke^b[&t.[,CDf9m;7ibSP[u7e;πU"86bt/6vgF6w:.+RsUH$s75gY0_KR6.gkgx$;ldrI=SusNQ;nDq*8?w<3irv%;0iπU"[gX4ksrWck;Oxi_bT#:ClS2PWv\Bqt.V_/cF6[Z/?>x2m<8-+$Wng,Dg)1eH)cOπU"INmkq2DP5-GotgOI.9LTOvg?9Lmp&)l-b]30cd^jCSscG1$aNlK/04d8ovT]jY'πU"cG'>rgFKK2e6D.h/pEg+.W?rxbUKKV7j]nG528Guj7HukLqd6:W8g:-U)$H'(IsπU"^G?VwQb)#VJ7>-H6UqY5pw&-?CArJhTPT9FfKOUCs#-x=wlA,eob[/<xY^RgiiaπU"*G(3b(?1<:]2aJD7n(6<UK$OGsLy?6SP9_Y>.[JXhpU<h]DeUXV\u3DKisDpsjvπU"7PJ/p_lJQDHlS<ZW1MtzYqoBSfi2*PgY%DB,rDnH0^%ESsq>*FJ1[IrcnKVg/<9πU"l4h$$1Yc43s*%PpEbZcg1^UP%kDN\dHj4oTpEK2sy0Oe>yJ,Wi\\q=v+01#vU>RπU"8[,=O^69=;kImcQP_M381xk[w)lIN]<SGWr0_qNVg^UwP+Aa1+%:=nJn>P<[g=#πU"<$heq0Qpg]1[BluY[+W#uq//#&:q]pQ;g[[yY8Y#>_G,n(a#E.1=drrB8Lm:DwBπU"=K:^eOF5x+4,.1#dh2v>dY-yVkVN1hAf^[IIM]Y$k#[r%-=UR=u9T._G**x^a*QπU"u/43Q025=rR'3ya'f;WgHHBF7u$7NVBdpW,^bePnIX$dI8a3Wn;r$XC$ZcZ:..CπU"r%vO3GJUjx?qWsxw=dm-LMJ[BsoZ6jOV^cYVWqQ5ApA1.2g7t8XX[g,JC5TTw5oπU"O[[z8'6z]FuH^eu.F-6]^ZI^nlg6*x_tSKW?ffK4H<RLNQ:7-YK.]+\'qrT[_gjπU"Jqn3*ot6HYRcG2Eto8J4BT83&L#O2>J%+YD,Ilvp+%pH9)Qm4dD;1s&F_mrTHEdπU"xYjNM+oK'HLU%kGQ&d]9'5_Z(>l\BWp(*+:r:Z^q.IvT59j$TFV:7BMFnpgoYlDπU"NBVBgU/=8c-_^veF%^BcP37:m:408k;TAFDQ\0XF6P=t($2f(1iFo=a/$Iv1*NhπU"-](=/\7^h=aA2Lyzf+HoROdrVaZ9ARvRd:2hKy%xI;p3(0IlnQzY:q3/e./%W,eπU"b#SJDCOdRP&d9vl/QZt-7q6(ZYKfa'[:m)s<faL)s=<QV76hK2kNHJ)/7+M*=l.πU"4$;K?46MTR[?i>Ug4g$A+81&tXPpj7nJ,92ERq'CRVb#Gk4O$B/FphX,a8'71.qπU"eQFUFjZ=X^5\vs_,[3GI+h1eV$4KOu>f_Q:J56i'E+^D5Et2wI]8:=Xr2_EMKK+πU"7e78OV(BPn2R:8]jYHlRNj(3R>5BU'\K4$HoG79%X-5HGW14Q^FK22Q8a./Lq59πU"^l<p7>7mQ6b&A12yg+#0dKGK?uO%g,)15A#&ihu)F,,bG+J$\)2V8K;W#U,u-nVπU"5$V'R]1Cr1XyYhof^:k3HJ-qrIw[<rq9E%3>8RFOjZcET4QTUvc.Tk6V(z/yYe>πU">TD<dU)FWWhs^h$sDmYrCiD<b62J^Zb%;j56k3f]:Xm_:TblMe96V4)FQ9)S7i9πU"0/vND.FkA.;L6U1?U0Ugqr11YEF)zgrR$,S'?t&N*;r5Cz:RRBO)^10:OuR(;[uπU"Pq[kFB%z2Hl4ooxm_8&$&COD/WP&_GcT*fV][r>Wfl)k82jnR&R6%R4E9a=.WDbπU"YwR'\z9a>v&Yz:*->S(#Ol*;-Z\zC^m*y[XOqWVAtOx3Mg[rfDW7DHaQRUWPAe)πU"PzK;(baH?#',>C-Cz6UDEPyV0Pi/,pJ]j<VSt^/(VBy.e=Rjc'iHocZd-aj\RZ2πU"C?^)mFi89AHYg9TiF6+bOg<dDLU5iNAB$cnPMqpDoV/yw*E2iq12)RQ^='/vV_YπU"%F)oLab)<2b&;#=O/LW^IvKVLyTU-2T7wu1:qd^spX<F2g33>l7=U9q*)0<JVD>πU"WePpq4C$A^v-iYTL,z)uorH]9M)?&*Q+RmnZW,d;jA3qM[f_xeF:Mx,j1*/A\l4πU"p(/JkH9(6PwK3>HCMuuB82oFgYVh(5y*T95JIz_uPog6nf9;Z*UMk43^R*3sJpJπU"omS1IG%a2Ju&aQ%ALW'IM=i]0m[2t=dU$UB:c*i/rH<rbo9hrU4Mx)m)WKW(ZT:πU"eBQuX$nJNwY%L[4[2h9*5#EINkY,%/:-koev4l_lJYVp;2]e)],F<hL,uCGT3'CπU"qx*d%TcBYUdwp&dllAxrwM/i_04a'AIl6ts\g.?H#_$2)/lA?Sovo4Sm=-2'I&yπU"S.ples%e<9WGjeD3(v-T(&ZJe+azA3e<opA'4qq1.)c*<5s^P7IHia.N_fnG<PTπU"5iB3A<b6\8p)qUyz^l#^eur6?991?%?X]L_?3zcYI)W$JN,2r&P>=%AUgMRZP.eπU",sALK/Lx7Er/tlWe/UC:;e)Y\FoUde6IDcUqxoTKCGW[(LwC;MpWQkU^U>Kw1v/πU".DF*^n/8JlPl#\f^l9[Brl:-6*y/J7'GQn?fn^N6h$Fkf+Op':kddL?gjg$lsS<πU"$^^Ft%Qaf0N$F]ggd\?BQ&mtYD9tA?NjJ:)w<6Q1vDJnixSb&Fx0D>luA)AX#c:πU"OY'etqp8&BIR9>UdpYBBYa3k)s$1To:IovWt$DpU<5<64eh^FFU2MjC$04$A*d;πU"iIeEXBcEaBs47F<v+#1r.0''(RI%]:+>/K05U8m_(<j3l:gk3Z3wb\_x1U(>75^πU"?lQ?=n8T6H^AXv2E84Y\d+SE9ZLgG(Q0haq#f3F\DLiJ1%AA:rE,+Gd8R7*p5sNπU"85L35hDPA=$^#IIZ;[*WKA1X#4*IWriqH<l8Q^O'a(+W\>:gH=%\PHJ??EJ><MsπU"J<ogO3g2e-Dj1obVee=6HW-f<9(??31'01rkada#7Yi<V:F#Sk\e>uPJW:E]:-,πU"$[WorR)&La:V[HY#Xm)/[o*%5Bp1jvotoPvY;a#0,?DEV3>Hx)UMbuGMmVK>pD5πU"Xy#el1EeoGlg1':C>5]t]I^#+&YbK5&#^Cm\Uyciw/W44>J0)<T8:#jI[SV.V=sπU"E+AjX.lj-g0.i9u'.+\%\3/;V<C1.y1WTBoWUY\q1Um-8J)NB]+Y:Cxb]]xc;TuπU"ng)t-7;TW(IJ<IRI0(a)+M4LJ\mYJ>K1Wv7cpW*I1EbC^uB1Y,zAAx#XzX#C>p'πU"]:mHgYrWoAggIZgmyd?*^tD:4f39>_)3^D5.VQJ51B.qTAumjD$Qh4eG:u9:/sdπU"pGs+miLFudh7VPiIU('g2MnVS*R;a8H7rO]-_%J^sElG6f7T=HKpD0K82gaxdJhπU"rL[FH;:/GAfr/(r2Y=h]ja5oJEGvj(Q*0[dS3tP<kQcI4U$u17P\+9'UpE+QeZlπU"maiIV+B)_J_^&V/TEpkYOyDk*=*;[]Gf5&2+S5w+5<O[1VG\16CH&rxR-'5[g\sπU";a;4%+ih;]q0rB[$3'lFCZtiF$1OCx$V95A<G/:k&;l'6QeIaL*u/t(g>)Oy3eIπU"X%o,lR>^U+XP>8;vxcGsP;tLi_gK_+7qnETeYq\-v:O=%h\>A3?_y3A-Zttk$?yπU"^g3ty5S&qFNGg;>D<3f>pPI9O<FHf$*>X\;:Y>2Y<C?Uf-*aj=2<;f(#?)ax?9vπU"6s9%CmFi&xXvUu_/l7)Lk6L)ePThL-rPU^i47kS#.VvqD;S9&Z&p/H$]-1D#X7(πU"g)>&)>wXf<&^ST4F=8K[Cf7>A+uGGH*mQu(J)1)2eT.-5bQ-(6\X8SUB^Ja-1K9πU"2].j/y%M=?H.?O8uk'*RK[Ri8(z1e,-GKSEeRM4O7IBF]/>a7f7dqiB>]ALJ#)[πU"pRhd=YCbSiog1\+vs'GHT7N)+1aCq+0N-r+BN.HaDLu]JN9&5US&#ddlW#18\.&πU"7J;gm2FQqH:;pe'*[Px0&#Dw0E8u;Erj/I)tiHyakPn;$%Cd4gmnF+<pIr=AvV9πU"W4PYAOLx(BCwx84f+'*ZzUa/fi-6,9NCl0^Uuwe4yGuNvI^tMC7>o%8bGjQar._πU"$CPya%H+Ho^BhkO9^fp$se40CQ;dhqjK5s#$k_Fe\Sbc6SZF-$J[A3DIy\vbKK&πU"dp=vSJK]WV[/K=p-Q>.MYxLg=;2ILds\qhhR=>nMAY2buSaDVbGj^a]A)q1T.=TπU")>*:6+,;^S>DT(W;o65e5rV#KtefXYElVlZ^0ob>VTsnQq_2umIR&-5NpX)JR(:πU"L%hqx1a&1.,'P+^>/[,S?g7Yu9&7+sBVPEt>$Vzy5??lp536Q2tSWoPUMkTB'_wπU"JMe0g5';-[F)g*;Z*asNMWT:POmZ1KS(GaZM&%6$Yq1s]4:Yqk+m#fVX(o8:wqwπU"IEUY[BXT0^UJ<=c1^J>/:2Lm.9,AfB_v1Aq(zpFL7bnw#SD+)m'Evq+o<^IsEjxπU"/bFTgTcb]Bq3Vc+Hp_)CSNhysyn7y#AC1cU;2UYfLiFY$FY*M7L(7t^gYH8:#:TπU"wN^M?Dskj,9YN$u&1DG>EFX\WKpbpb]SXau\Hh]ajd5KTNrx/W6'bIP8vwIT*xnπU"qEpa>,87+sx#PnD$9wm?[iOgd&jV&g1*KMslZ%n<Yp27v)reU0pH;2Gj8^9rLsrπU"M,l6m&AdM=emeN4M_4[yDb-2c$jWe?pJX#r/qkK3[Twg#x8<$spsO4rab+AkX%,πU"-4u(K:0y'\[s;y9ifbTF_BTl2$9bD^s'FMK<sna(H,ol0g)o]$AcFE=ueRd3,J5πU"NEkr4e3pg7_'15yjStuQ3:]C%0'C=xbRter\O+)NfdRZYW2JZ]7w(8X(c5b#\#'πU"TsQ'F\J[[Gn01j*x(\N22uPp.FS9u#CBpS*GRe%:zzU')0RWCnmLmDIU_^8]>OHπU"(d]qE7rM%otus1ZP=\r_hB84(KBqaIT(<Ti5)sd\2J9PJ3bLUIdIxnZA/1Yu[U_πU"BVB_1X;:Lc?si]e#Kt1tYo1J[.5Rh_k*CdDN.2-Pc0P++r7S2%htU]_.YYA\8E7πU"O?<p;(#e&FEJS$3]*L&:\vT->NWd_zLq]8/[4wk=p8&qO8zpa)?9xRZbG<,7R7>πU"peIA3Cq.TvE$cBUps(?-:]S6)#S$FD]UBVV2Q7f&jRaI4$[>;^g3&kbcBGk4]<0πU"m<N0H=N)?b1s]2i(RCBPvYBXfU*nvUt?>Z[]]&Pu7Y%l]SL\w>6AZLTcpcP_Gs%πU":+8)T7?;ZU^(AULi08]UuB11fUL=f\LA[US#*e?+lt23=4LLz_niPgTut;8Yj*vπU",ec:SQH5W(GhL/4A\_s;$gG-t]LLQ,6_K6o$B+i_$72rkXN_]k/gjJ<]D'Ntz&/πU"SQ23'Q[ZH-$iK+*cH4$jfZpGBle*r^4m<x>]U8OtV'5vOPjtdeasDGR<JaF/^K&πU"P4^$/)Q5E(/C4Ld)V5KLYr%DCp=eC3M4KWEfRUXl'\:[):AIP\Z#S]miHCmw6RBπU"[<t#0qPJ5gt%R1]Qxu'VXGA+X:<03<Q[6gK*GVDC]?gVdF,bBXu+aPMU]pR<5qjπU"uqb5l2L/p/?RQCo:fBozL.B_6SR1lr7.YCSWIY<K'[.iuZ\7'm,;_e'G+X&FxdyπU"w*;.^VSHaPiwnprGK#aYqdg,bYE52]8c:/c)kW;G9SNC)yH/UTLJaJu#^PSIbmqπU"CkRb0^dYt9M,hnV$:Re&BDG(3LW^)&-jLJrO7r2QlJcneB#n]=>w>\Tp^?Y\6TXπU"4XY0IR0:Kcu$'=rL#f\lSknHHi+(S^.(DAPqV\sM%I37wg5FUgz3:eOeGk17[:]πU"'C(O]fM)>&'Qx'[Tb+81oRvo=o9Ji8Mln*\zjI[=-9;iCRf#sADN,z4;D;fNdx0πU"v/RPNV=Gx_p:g^IcBp[R7,a5GoFesu7OCWoi\NlB-7SfZOmUt7[KB/i%?([ZuKcπU"pz'$j?M.JR)H$4QpK%Ew9RFn^79J4:%[Y<1yWet2qjCnaJ_-=osMOQx^*tYx.CvπU"akrTT4MT=,0;cjlFRWeBIS3PJ_WM^.b9.7tl+rK3)(dqz:?GS:;U%$jm)$Yl9b)πU"*3\WUhPXV&kEcMhP,0or4[l<AZm]%9Hmn^WKbWuKZxfrR4k$2yN-de\8ZHXR)e\πU"M-^;^9/.cnfxP9k'l_C.1?6U^1;JU(\E$iX7YD&X7D%Z_DX=S7q\;vKxi8S/A3ZπU"8&4=Mx[b1;Lfr'z7DzQ>5)(q]NU99Bk\E/,K=V<FP1*Bcj^zt=Ea_BR#qq9-.0/πU"_#'\FE]:iMnadu(###uj=-QtRTmiF5MfpXiCcguX%]Ed3]xg3MVj'183]p48U9CπU"i'km0iv?E4C-BM'1.T)CF*nMBF?Ps?<dH1T6iErdLJn.a/e\nttfW$\\:TIPD.XπU"aD>-YdZ$^g9F\jG:GK6^+:&fLfJ7fZlubJwAH,,3\\'w)S+HuV0R.*^VjF3xPvdπU"vr7I[a?U%%8)-8R%Sw*V_4)1hSL__mDu2x6Y-9.7RP0soQLAjV^Ellft4A[LTqtπU"/hrmoShHw?Y2(cyu<qTuC'URm$S'qxJ4[pszsJ-C2D9PpXpY9\L+f(^',I$c=#rπU"T-eOg#518sYPmirxg8;g[GIV'KkfL6)MY)aXR_gFd:,&Q9jw]p4fAONn5bj$Hn#πU":Z^-7rdt2O1P7(Nk)h^BHReFkuU&_JJNp)XOZL+:JU=#?M*#b%]f5tl.PkkpPp>πU">5>[g5*?boWgPo#>S\+*P;hAgC#O**;_kg-dTF?sf+,#]XQf<rL1TnpU+TCm#csπU"7</kR#l+/8Ey(m*%IC;kmrN7mLS<=NwcL,5\?=T#X2o,?tPf5MKS]2b^p9g;4FEπU"Vc;dUk/e63KN$*Y#'cFlbSOuIY8<I4jiZD6/MgTFO5'EPdH[i,KT1sWnZ;6H'['πU"Qe#3iRpm,Kn_F-R9FP.8p;>Gti>7-/9=l(2toyKkl>AHm8ifiIrAaU+0h&6kv9DπU"Et%WA(t'/1*<i5YMp.ZAl_o(*8w+[r5vDLa4BiQY%ls6T=fji'Jc(+DW,HiRO\rπU"GZ:\pg0DDv7.U8)'WHFP8GffY0hVa>:1='C:<-4ZzU0:vsmDWcmSE(AFcdP.%RWπU"p0(d'vhQm+qW>eX.C\j7(wj]PvQ^&mQ#]Wm0d;t?2d7R&A:AWL-+Fs^Z3waA*mPπU"(2//Dv?[hif%Jdyt]>[w[0^IKM(yyVa7wmWi?
U^q:5Md3GqIp2Qs2$SfwloZπU"AURhVDn*i.3*c((.\c_dZr4O$17/#0LEf:13%i6.%l.0:)4PU:F6bB&d]FK++kWπU"#ew%.JJ5;,3Mn+bZ*\Nb3s^.aiBnHwj8'YuBLRt%B>omdNwPd_Pv.^\\:D_npb\πU"uWHSn3o&C/zw8x'&HoLu[Ke##4_cV\meLZxvE:xWUKr*yuu'FF.o4efW)CU^7g%πU"Q.)hFl;c?ejI/HqP[EY&*I'_%p;mC6iZTFNbOH#pOAHl6mcnZI)ENRaUWF%6%T(πU"SIxCxlZ84EB$P=S<4QYYd1aAB^KW^%RLOAIVZ5G:KocAw^m_,kuqnHFu;xvq\TgπU"Nwk)]1rdk0wVma8xD3SXZ6SB12W]:a9im(Iw4-7O&*UPg)Q1..X0uH$FXF1aEXxπU".GjgI'wD'F+<W&k(bfFsI)(ySBT5+QiuGk3k,t5cUki3fCplx;J/UuOMO&Vf6S9πU"/8.h+HM.fZ_Lo'/2[/.unlI5MQ$<N?E,/k#s3f2pRP,<jPGC+W,p;O7)v7Jx.-bπU"eD)Mm>4i]3'\'uI#n(85[%Fxl=0bG,Z7<2u,1:1,gh+yt=U)0X].()4.m,)^πU"d+Cx'GODw0$oFo'E29+r=4^ZL[i)yo'k-ln,XVj3.?1g(iWc475Vn(6cWPR;YS3πU"(/?4S?su69dRZtiV><7Oo'ORmM\U=kFWe0SO010)ojc-L']rMY$&iYm=m#k42-FπU">X/=V^%G8S]YxlIDj;#8K8MOBG2R]=\=Q##2ar\)&'szP_)tEUez\1b=HH<vrgCπU"cU>E([UNcId*jT%W>*'sG$4.,++#haOi1:GOaPW/FGUDOOF'.JGQPF:iV;Q#9RXπU"pTG,^%Fc[P,*q1'-2F:GZtZw4+nf#o+dUI(mM9g5Ok.'E*OH)IG;=J9NPQQ.=_IπU"f]2E#xmS*mbKj-X$DUpNaJVv3,4.4&,(a?7UW'-$jdIzeA=j1*1/(Y#*d5gy*1SπU"z+:3;Gk]HSq7wAXxB[Aszsy%7N_yKjO)sOD$\.8GGp6MAzg>XdLn<;0R:dcO5DDπU"9ODI<OrdZ$7p9?tK:a%2$;2:=]g)U0lBGjS>,d8FO?^j)>jIs(PO%0D_=Uadk]#πU"6'tS/0*[h]ab*jj,6Gx5*xPFZk9(-dR-Xh0BYr2aYNXai=2h(4+aj;.5?5F6hziπU"bt9;FpZmd+b07L0nB-&?o4%/<tV4qGUg:/lgH_B^#/t795G/]Ju9JZX+WFS(l-iπU"L6(2[7r%l<%jWgHl=0*NgHCd/pEX&m(pRs+'=5dt/2xwTyKP:1N\.Fz.>_S3gECπU"^RSV^UMl>9ufnPMJFRlA/-X>1o?&\()0UHV>v[XvW5pJ9C_]:\*GF'CFkw%AoS7πU"IbE>6Vb^V7#TkvkInSYD[ekD8<;>\K05N=J':6<xQS5(4t^wD,$i?T--5>wC/&QπU"goM1K9m(OXyKJ)oqtGnXwI.,)G**Es+c3bn;#q\j\'Z<k=^UI0jR)B'.'R%]gBHπU"EY0KA26l\TF6rZt(XVZM>NP(-*pq3XNj.tT8_s:M*N\NDYXVplukkwr<BUZhLYFπU"o0%+hiA1v%MQGP;7Hu-V/2xl[v-qr?)bt4$:h3.C2G<k7^BFf*UUxhCan^wRu#]πU"5a/./(nSWFSC))?O(U&ScGj4%<6s^kkW[i[LWp/<>]5n?GOB9Y/wt9tJo37Puq0πU":i[X(&_JwWqg3;65NQ>M(gjgt6-:z?AMH0WQhg7tB=dsc7ui2)YRWnfh?nR\[2<πU"k;^<5Bi4>+3N+n\a.oGcf<LRvR$HDFM<,oS4K\oJ;]h^su&^5e;>dy5f)Fx#Fz$πU")7G%MQe/L*byic83<4cSs<4/'$?s%G&JvErZi6])+>apGTBH.1-RDU_j5;<<-HgπU"?q7kqC3\x:m1diygf)T^neyX4o*7#^3W^UvLWJ5U#B5K+Mr()_D*jAfQMltkTm+πU"W/.nPqdJ23yC(X>$J3HcN23ES^K2Vi:a'#[4UK.QB:8tlG\buAL<2MAl;vPb-nGπU"&hzA>p+R]FAcO2$h=<Wm*XxFCFb/F5X%xmU(mNqheKYhFX2jJ37[\=l>bRK5IDtπU"6BChKal0F2#$Vlsv;);W1EJ'RbtU1j(,4x7qNh%z:b06,e5HiG^RLT%=bk%Q-0>πU"O4/FREn&TGxf%B>D?Z&8jfU/3Yy$yIPu=&e9H*BK+';.2wIUn<1(Z6<RxFA/+qRπU"VP%%8dF63sRS?x#27ymx*UyGm<:OsTzng>.n;i>VvJz0p$r,jr,^7hR;P72iI5$πU"0.a^mu>Q)\?=Vu.ak7D3?V%9$;$hfI(]^mzo_:*(suO$uyJK'5ipI0'J4Dc%FO$πU"=6%]J5%0dw)*.obh^o8]quiTC#VF%/Nvoi&dt4y$Oc'mxaWv8n;AnMp9hVnW8LKπU"1zUK#ZDm9iexEr1d(801(b8iqW%V7#DRIn2P$4+8]Lmh]Ha&Ema^(f1J3qCoEj1πU"7qgJV1^\QIIu+'$uGmWOZHYGsrb,[J7aK%TETdoa)PBBBB1w^AXvH*_Op(6QRERπU"hDU%Zh$Y4uP*BhMHu?CJ'eS$QkYdcVsDU.j$Fe_JxgnTbx:J>ez'a9/a(Y'rg+pπU"_oy2b^/:/SL>UY4hLHcW_Y=ZjmE1WRODJEQBxH_Mva4HCl5n1^=&nVFc$^<CBdQπU"DH=<:[Jw8AiF5B8ZAh_88X,#6=4focpTTh*KR2LS%uGz3m)V]1Ll6e?#f9:R[0hπU"^i(u/cgdbDPjed4.B;V6eP#AL#b7Yke:ASI:WMQOT5P'*5w^5rGoF8lVj0dUjVXπU"KF#KPf?cllO4sEXZe38py'#%3[k<0Q4<DgLhBZYc3dU4fT)DO/0_**bL43nh2[)πU"D:\Txv=mVqvcZ$0(N]J\>=/jVbrU]$PJIO&HsKP*B\ll3AtFoq?Rh./T2o\^m=hπU"e)#qIzY4Vo//6]4$WgL(%+pZ*D.K;m):y^AuN4;(kVQ-t)O=:XsXQ400gecI8&\πU"jSw+,h?rZ8]IyK^F%17km).>IQ-5P])ez8o#Nnk%*mBSS=YC4$Y>^nM:lsXE:b#πU",o&nTQ[^UA1(;)HDxMEF+$*KbEB;wi:mbOuS;^WZb5oN*(-_PG6?,>*4n1=2R<IπU"C^uEt3+q4nY&4[O1^<QDQ=PT*[uu1o69W+)Dcs3#ow/I*U0/j+8^URDY\r2ArMyπU"f)s[ss'#]wjoJ0))6:(fgXLGHx1o7<B0>W[kdaJK-g'*6X$=8'W<f_8KK\.;F+3πU"WHIcS0m99aui'KiS=n%iiXn\%w2&IfPP+$Gh7B3>.kX+I:#\mS&nZZk1\AdOE6fπEND SUBπSUB V2πU"e5pF=TY0)247<y#pKwDw'g3;UO9Z*Kadd4TE$r2PH4[oR&:*A#f8PS#;5&%+'r%πU".DBQ\)q>LY7E).FD9WNL9OB:4aMTbh[iadY'T2$we4'*odu#*+ps..yAntrY;[MπU"Hi,ea:,yo8o5:yblQzwifzf;UJ,ZD;;U1Fm/K8?5m1I5?,j/MPg^-(k97t^M*O>πU"z6r/mT=(HJF<TGk2<G+[b:w4%M118O6Ve-,G2dcYe2D[%P2\/t5E%<-E=/:O6^AπU"6dPjVQ(#W)(1Eft#4D1G;$R,Z)j[X*Z4i0lzy^*#P7^bFYo<d$o*W2p=Hla>L$MπU"FrhM2qJV3f[Bb>XVNqj4-hY,7ai'PKln7-pQo_I>G^GcP\s_IVC%9dq(0X>mg&*πU"(a=d.8n&FP+SF,iJOM9RwFk3?$%ERt(WV#8<8BrJNI>.YaUkk#l9?LmDc%dRCD;πU"xMPA*+VGGojHMq#-0LrY54&5b/1mlR_1_zQAHp+U7wRj?uM9n5U#<g/29x>$uN2πU"6kBJF?$VP-V0bS566?wBO4kE>S(>qEfGCm<#qC(KM0Q$.jWjhes%)#CLP.q84hGπU"mMZU,dPdgQd$(I(C%%W5S<-5&i#.0dr&y4R+y9J8O4-'Kl9O,XM7GJ&O$zo#5B\πU">k#?nlk_5>o$7Y:kF>;mSlG4d:p&,W.alS0bJ>GD69?5C^e[M8g-0gC\roC=,G6πU"+oHik:.ok)?DqZZ$69JfK.ui1JEZ>Lel0:Zc#N6a-1K<B,G]L)LWo%pcM]/#i2(πU"XxNgu/8nCdIH\/Hw7IXH6ZKrUvzTV8ZQ=7)Iz^?hl+C#]FFAU#fpuadMIdnmY0:πU"%2ie7D/WhBoS)>Kwi&2&k^7zm+VytNG_),p%GZ1Ad&:HL2Ujxa8jy9l44h$1YocπU"3s*'=owQ3*aemf%Iq=Mdye%3_O4R%6J[2)l3Z,7#J/Q%R2*[rna2=D4yLqOQ.YmπU"5WKgURiAnjah0b50a.pP)9ayr\aGi/'MY$(W>:1+G%LO(okM%&quWC&;y8n1Qr1πU"9dXIG6%^Gf7Rra+mX(gl0F\zo/FDs?>8/,naG9?.^18%jOmnkwF9+I/#LQNLc2EπU"Za98f.nY%j=$=.tkU.uErkp5sz.-Qq7d-=)7di$IpT8t(o1JT(Vexn%pIz70d^+πU"#C^8w-dZReq6-TBjXbSj:IGMN&bS]./b]'-#R89:Gd'/4JEq,6W+LMx1=>U7811πU"0az.*K=t,2Pb(.#:QuF=cNXL-&r);id>jPpC)a.5qV8=rHO7[ve]V2ts#FM:ue'πU"EHeGSIr&APFx[vPh\fC.kiG*7aaM#3i$=BES.kgGiY[jhe+CA'=)hk<jCW8O0dUπU"n>l,0bjkxAD#rG8,X,FH)JW2#D-M^(MG=bp;MtiVtCetqKL8?6h>qioad*w9cTaπU"g+;[UN&YNs^>'tGfLs(?4hiWQbBH^OQHX/[qPO]nfx,KG9iE&IO79u+m)igB6K7πU";,$IWi(g(I](r$u6L.=(caw^.M/o'qK17wsv7<./Q)e&Ep,PB?tX65K)Czu-5Y8πU"L^IW1nEf>9A+mYrsOEl5BYYdJ3#9AzpBYk[U#0%d?4T2I=N19\nJmj3K(_9sQ3cπU"9Dw,w6\735d<4F3FBNI#Lehgpc-:h2u#+vC?(=e3^8rqXrud7pA:2wAfv<^$=xJπU"OE^J&\ZuG/YjD\ATg8/&f$K'eM6#;)f.uglL^[g.]/0GnV<n#:Oa&I9*4bwMp*uπU"xGT;&MsN1$Q.q42ZjOmMYHteFUq_lny5Odg-m3Y:fMff96KnQ&9x$Qb_dVO_+S[πU"3jC%qle/>$[4(tSEDajEDI4T37hrESBOVBB#6HUR7K#'IZ^CQu4%&2fw=W?Z?8YπU"QYSR>5#NhdoA9^TQQHUccTkt)kgG?]g\X*oE&p=kHqBe:er=9lp=a$Yk-1H;(*0πU",&*<m4a-1q0(V[Qoq]pN1Uh*d./D1v%:0xe6><U5+<.esRV:aaKmMk'lc-WK)?sπU"y(:NdSv.&(Yg-7a/nFEX5#$Y)j'hsO->(<eMeH?gsci't+wqIa8B=BF(S/d$Dn7πU"55]v_k%fh5t\R$AlykK*E6->gn:aBA2R^U/E/No(\q2;HK<&DN-om'KSwu$[RtbπU"ST-*T+S^r02uLnQO)E;P4V*,QL/kj\08#<^rtvpwcgf8vpsF(9=5DamnM'p1M8WπU"&_Lp/0r(8oGIDHlP\s_?[pB-qs+GnNW2KcA&9r\g61bs7uC+15'1Lfhu^c/76iXπU"&3CIOi[Aqx$:rlg>1S6^$pe6fjS?F,P?M9lY'a<t.+Z<N1T#kOC(,hsD$*465Y$πU"XRs^XlIc=l-A4\j,4J)$wsr9->vkoW)K/egB^MKv?gu-6&GLvQy]Ut838o)\=CaπU"&,w'rt#/v4KHjLHHj%1Sz,Hp$v9Xf/r1<z'rVgclX$a/qFVxf/>ZT=+U*)*A&=gπU"kj7,q;>;hBJumS:QZ\eA$fKjF,G?gT=Sr$ZAu5bM4hV*s=utfew*WV>o9C0=k)UπU"CZM\?ZU9uIKEu.7\zySTr-y.x5YzU82Vu4E08l-$qUlYY8=%_pyN8^V3Bl5f=BwπU"jSYhT%>dP'^Iwwa2XdirU\1v44jAy9+UxI:Vyrl+o6B^cgMNGn2nrryFhDh[VJSπU"f=jEj.)4:&\niO/;GMNPPSRj]LbEMi]/-EK9c]P_C6K/#8PbBVut]B2b2VpncUYπU"]wLdTmTZVW%neV]ULdmX(vINqI&x]kVw,ujur6qFFF8DnmaJLPWa81Qo]WCmlyrπU"bt]a]B#6b^qSvFJbILoHq9Stpi]FLtm3]Xma*JbLo(T%#dTV:.m>+JL_EJbPIJAπU"j8&1iNUP'[FRLL(W/C=<L:2PJY$[1aq%2.?803r&$tPs00h1&[oAjGz\[A](l;5πU"pqO(i3s-XsL=hG.SAlBJ1jw0/U89hxOo<zO(J+Aw&ZUlo;Lz>I'HW[iVO6g1fOTπU"2W_*B#lPm5.H<h$pVn>gq'^#hv3CM$0mTXI:sMX3uxuWR58uoK_vb\0[DNsq?>qπU"Bymq4S^p$o7=oPa)A's5F#;dK>av1DmH1+LOG+Z)B]^T_MQPFjp]5b<xL^TLK.$πU",Ehb4P_t#]m^TvriLZ8'3<^fLs1lV<N<)/7.]upgD8d(aG.Q/njJ-;mMcH*5b,)πU"kRIfo,?>Co;rH5vS.8r$Cq%(mzEy/:YU#LySn'h^jzu1yO)q&;ra^q5:JXbf*8-πU"X#32X<lv3jV3]53+4bOiVG4gvJySx]cv5h7?c&ojrv)tMg*[-cRwq^Qe4HDd8QnπU"\p*mxvG]Vj]npG28Qdbm]R0Cp22Xf7nlu]FF],lhItL\b>N1LH:RZrE:i)'j,=aπU"6&D&2XD$^%fh:ngWge;[lsxMV/ZKgI=]+np/V+Rb.0H%k[5aJDlmmGCRAW_l(,_πU".%AE$2+yH&OqvPY+&q1yJR(zBPMy5oy7^u.1Mc3-<JN96$YiGER%a]P(sllYe%QπU"bP<mSpHGhRz3bqdBZ+KmOH?T.Q69LS+e-mR4GFrKz$;54bhk1Cor_#i3<&LmG\vπU">z]e6QL]tsO8fS0.+aHcB]y^]tsE#OfT-y_*>Ve.QRq-a0Q&W75/1gRIuJ4=1K4πU"M(4N3h9/LYx\cIq\Ku+/ICiUPO7pO':e]\k$.+*6EdYhkFfpWsJO5.C_S?JubJNπU"Kn-qcnLp-hNIX^hn-1^hvf'vTbJOMVIXnnju[U4/2g?qcZg33LdgcGNHYmFboUKπU"<q6e[cLfJFvehA[[:m?01u%7*klD1sp3D8PAR7+#OKfA/M%$MGyRy)thJuA'C\2πU"94wHQ6ZWP,B16onyP'Q(:ZA4[U/(RdH)Sppoq6B7UuRj'qd5<Amq2R(P2>-PJS'πU"ilcJ9]i_Z1KA7uR(Uf8qDGk_+j2j\Mp2T30kh3,tsScqe*&t3\LfKV56/i-Xr7.πU"hdPH(NJr&5m7Gm3.Bi&%AMoj4CI%7?'ojRo7&pT_Ow;7P&A/tbqer1Kct+0mCTYπU"0>q0[*cs;b9^lMBZ[px#0p&Z9ja6],ZX\sqH#Cn9W#]p70mP;:r\S4sR3nqqaxvπU"VLJJhUu+.aMkWvR8g1k/GOp7W:kf;^U'AWT[0tkHv$DTku'x&up%()9%%%%-%,xπU"%HEhX#c[&M&%%%w.%%%-%%%%knlV%SifyE^df='=E1jNpdIVLAoZ/UUPlnH%^x[πU"SNmJ;/5z\Y&i\5#5NllHlcjD=-ulzd[d_nn,c[TJTj$^)BbA$r(L8vYKrMb)JyaπU"EU<[x(N0&NlxgaT:]J:&3_+W.MVV[g[x^P0VTD^OY\%/vP#/8gries0(EK'08<*πU"cA2$&d7P6Kus7L0Lxxl_sh6(D#>vJr-b.8Tj<mSPQcFiIou-Vf3]cK8,WcZj=.1πU"+8DJs?]q^)P9lV<R7KjZ1?4,Y6+H-L3nFmk.#pF*xPj)Q8tU,E7/6G(Al#NusD'πU"<K^n#9Z4?txuCtYp4JY*uWEY9n6lgy.u1Spqg'dnrfcrPgI*:dw#qS^Ytva0:^vπU"sG'-c-+&FdKLsfl)mWGT+55WZaHcOJnl\;NdYJgKibd/3fF'q=j8lqe1qh5IavQπU"u]AXnIs.S8[V827:l$eyn$IW:vZaDWeM(:J(VSD<,vF0FJLbu[LX2\yn[+qavmeπU"2WGc)n>up%()9%%%%-%-&%HEj*F]t&P&%%%s.%%%-%%%%knlW%SifyE^dVa'<E1πU"j?tE]3%ce/5=-T$d0RSnETm2js3R9jqA-5'LEjdRVlf.tk*t#cDY\]mcELjwqiAπU"2uIjH>bO1TiL;CHx.YjjgmSkiKiKab>xUDJ32aIsgSoF9XyahvuS^E%:6jQd&FqπU"pO_YId?>X;pie,bgg)j35+<lo0;o3DF.&TI4OnWYj#=:M5*Mmq3H)J_[_ffnD$uπU"7cHP'SM)%Ipkf&+r3ht'&=?P9t)Zt;kSmpsC;=LUVJ#+t/,B3$uiiNmF(\ow\,PπU"IF?fNZyb-^fiA#QN_B(J<I^#eeq,rMVM^VZp4J.KqB$I-sW3OfX7-Am,gGjDE6wπU"J2DTKi,S+d6GA_J\Hwbi?[3_[L:gfT?NCa=DB2x<(K]0Q&)U5irpJIl\7JL()78πU"k=uhQW6:e4W_<9^E(U,lWPq/IhhLgK$a3mq]Q+sUZse&yf_rK>fZNjEcYv^(,MIπU"J;J9B1nfS6;0bhg'>t#K9mM_c%rbbD%dup&%'9%9%%%%-C%Gf7(Esz>+[=X%:%vπU"c%%%1%%%%%%%%%&%E%%%%%%%%%x%umwk%nyjS%gfxu%p&'9%%9%%#%-%xB%HEXVπU"#c[M%&%%w%.%%-%%%%%%%%%&%%E%%+%gX%%%knl%VSif%yup&%'9%9%%%%-=%&%πU"HRE*F]*tP&%%%s.%%%-%%%%%%%%%&%E#%%%a%Z%%k%nlWS%ifyu%p*+%%%%%(#%πU"(%u%%%%^%\%%%%%πEND SUBπV2πCLOSE:IF S=223AND B&=Z&THEN?" :) Ok!"ELSE?" :( Bad!πSUB U(A$):FOR A=1TO LEN(A$):C=ASC(MID$(A$,A))-37:IF C<0THEN C=91+C*32πIF K<4THEN K=C+243ELSE?#1,CHR$(C+(K MOD 3)*86);:K=K\3:B&=B&+1πS=(S+C)AND 255:NEXT:LOCATE,1:?STRING$(B&*50\Z&,219);:END SUBπManny Najera                   BALLOON X                      www.flashgames.com             03-09-96 (16:53)       QB, QBasic, PDS        2096 66106    BALLOONX.BAS'---------------------------------------------------------------------------π'Balloon X v2.1 - Written By Manny Najeraπ'π'π'How To Play:π'π'In a nutshell, you fly your little balloon around, looking for gems.π'You need to get gems in order to go on to the next level.π'But beware!  There are missle-thingys and torpedos and shrapnelπ'bombs and other menaces that you have to look out for.π'--> Just press F1 during the game to see the instructions.π'π'Other Info:π'π'If you are running this in Qbasic, you may see some unexpected imagesπ'during screen transitions.  I made this on a 486sx 25mhz, so some ofπ'you other guys might have to turn turbo off.  Basic isn't too well withπ'keeping a consistent speed.π'π'Special Stuff:π'π'Much thanks to Simon, the guy who sat next to me in word processing class!π'He's the one that said that this game was too hard and came up with theπ'idea of making the coin enemys into extra life thingys.π'π'The source code is pretty cheap and choppy, who knows if you can useπ'it?  If you plan to use my code or ideas, Email me first and we'llπ'talk.  Don't rip code without permission!π'π'---------------------------------------------------------------------------πDEFINT A-ZπOPTION BASE 1π'$DYNAMICππ'Declares and suchππDECLARE SUB MakeQuits ()πDECLARE SUB MakeHelpScreen ()πDECLARE SUB Center (Row, Text$, C)πDECLARE SUB CreateTable ()πDECLARE SUB MakeStars (NumStars%)πDECLARE SUB GetKey ()πDECLARE SUB ProcessMotion ()πDECLARE SUB DrawBalloon ()πDECLARE SUB MakeTitleScreen ()πDECLARE SUB DoMenu ()πDECLARE SUB MakeIntroScreen ()πDECLARE SUB DoIntro ()πDECLARE SUB DoExit ()πDECLARE SUB StartGame ()πDECLARE SUB DrawArena ()πDECLARE SUB MainGame ()πDECLARE SUB LevDis ()πDECLARE SUB DoTorpedo (lev)πDECLARE SUB MakeInfo ()πDECLARE SUB SeeInfo ()πDECLARE SUB DoMissle (lev)πDECLARE SUB DoItem ()πDECLARE SUB DoBItem ()πDECLARE SUB DeadDuck ()πDECLARE SUB Initit ()πDECLARE SUB DrawBlankArena ()πDECLARE SUB StartBonus ()πDECLARE SUB DoBomb (lev)πDECLARE SUB DoDemoMode ()πDECLARE SUB LevelClear ()πDECLARE SUB DoCheapEnding ()πDECLARE FUNCTION PointHit% (Hx, Hy)πDECLARE FUNCTION BoxHit% (Hx1, Hy1, hx2, hy2)ππRANDOMIZE TIMERππ'OPENING TEXTππCOLOR 15, 0: PRINT "Balloon X v2.01"πPRINT "Free memory bytes:"; FRE(-1)  'Just wanna see how muchπPRINT "Loading..."                   'I can stuff in...ππ'DEFSππDEF Fnr (X) = INT(RND * X) + 1ππ'TYPESππTYPE BItemTypeπX AS INTEGERπY AS INTEGERπYm AS INTEGERπnum AS INTEGERπActive AS INTEGERπClock AS INTEGERπEND TYPEππTYPE BombTypeπActive AS INTEGERπClock AS INTEGERπRclock AS INTEGERπAnclock AS INTEGERπAnFlag AS INTEGERπFx AS INTEGERπFy AS INTEGERπSx AS INTEGERπSy AS INTEGERπEND TYPEππTYPE HighType                 'I was gonna make a highπPlayerName AS STRING * 3      'score table, but I wantedπPlayerScore AS DOUBLE         'to contain everything inπPlayerDate AS STRING * 10     'a single BAS fileπPlayerLevel AS INTEGER        'You can make one with this type...πEND TYPEππTYPE NormalTypeπScore AS DOUBLEπLevel AS INTEGERπGems AS INTEGERπGemReq AS INTEGERπLives AS INTEGERπEND TYPEππTYPE BalloonTypeπW AS INTEGERπH AS INTEGERπX AS INTEGERπY AS INTEGERπXm AS INTEGERπYm AS INTEGERπAnclock AS INTEGERπAnFlag AS INTEGERπDead AS INTEGERπDeadClock AS INTEGERπDx AS INTEGERπDy AS INTEGERπEND TYPEππTYPE MenuTypeπnum AS INTEGERπClock AS INTEGERπEND TYPEππTYPE TorpedoTypeπX AS INTEGERπY AS INTEGERπXm AS INTEGERπYm AS INTEGERπActive AS INTEGERπActCount AS INTEGERπExploding AS INTEGERπEcount AS INTEGERπEx AS INTEGERπExx AS INTEGERπEyy AS INTEGERπLoCount AS INTEGERπCount AS INTEGERπFx AS INTEGERπFy AS INTEGERπEND TYPEππTYPE CoinType                'I was gonna have this enemy calledπX AS INTEGER                 'THE COINS, just coins that spin at youπY AS INTEGER                 'in sine waves, but they made the gameπXm AS INTEGER                'way too hard.πActive AS INTEGERπActCount AS INTEGERπAnclock AS INTEGERπAnFlag AS INTEGERπEND TYPEππTYPE MissleTypeπX AS INTEGERπY AS INTEGERπXm AS INTEGERπActive AS INTEGERπActCount AS INTEGERπEND TYPEππTYPE ItemTypeπX AS INTEGERπY AS INTEGERπActive AS INTEGERπActCount AS INTEGERπnum AS INTEGERπEndCount AS INTEGERπEND TYPEππTYPE StarTypeπX AS INTEGERπY AS INTEGERπYm AS INTEGERπT AS INTEGERπC AS INTEGERπEND TYPEππ'DIMSπDIM SHARED BItem(5) AS BItemTypeπDIM SHARED Bomb(30) AS BombTypeπDIM SHARED Star(60) AS StarTypeπDIM SHARED Item AS ItemTypeπDIM SHARED XSin(360) AS SINGLE, Xcos(360) AS SINGLEπDIM SHARED C(10) AS CoinTypeπDIM SHARED Missle(10) AS MissleTypeπDIM SHARED High AS HighTypeπDIM SHARED Current AS NormalTypeπDIM SHARED Bal AS BalloonTypeπDIM SHARED Menu AS MenuTypeπDIM SHARED ManX, ManY, LDF, l$, Active, MpπDIM SHARED Tor(100) AS TorpedoTypeπDIM SHARED Bl AS DOUBLEππ'READSπDIM SHARED Torpm(16)πFOR I = 1 TO 16πREAD Torpm(I)πNEXTπDIM SHARED Torp(16)πFOR I = 1 TO 16πREAD Torp(I)πNEXTπDIM SHARED Pl(30)πFOR I = 1 TO 30πREAD Pl(I)πNEXTπDIM SHARED P5(30)πFOR I = 1 TO 30πREAD P5(I)πNEXTπDIM SHARED P1(30)πFOR I = 1 TO 30πREAD P1(I)πNEXTπDIM SHARED Mrm(22)πFOR I = 1 TO 22πREAD Mrm(I)πNEXTπDIM SHARED Mr(22)πFOR I = 1 TO 22πREAD Mr(I)πNEXTπDIM SHARED Mlm(22)πFOR I = 1 TO 22πREAD Mlm(I)πNEXTπDIM SHARED Ml(22)πFOR I = 1 TO 22πREAD Ml(I)πNEXTπDIM SHARED Coin3m(16)πFOR I = 1 TO 16πREAD Coin3m(I)πNEXTπDIM SHARED Coin3(16)πFOR I = 1 TO 16πREAD Coin3(I)πNEXTπDIM SHARED Coin2m(16)πFOR I = 1 TO 16πREAD Coin2m(I)πNEXTπDIM SHARED Coin2(16)πFOR I = 1 TO 16πREAD Coin2(I)πNEXTπDIM SHARED Coin1m(16)πFOR I = 1 TO 16πREAD Coin1m(I)πNEXTπDIM SHARED Coin1(16)πFOR I = 1 TO 16πREAD Coin1(I)πNEXTπDIM SHARED Bal5m(28)πFOR I = 1 TO 28πREAD Bal5m(I)πNEXTπDIM SHARED Bal5(28)πFOR I = 1 TO 28πREAD Bal5(I)πNEXTπDIM SHARED Bal4m(28)πFOR I = 1 TO 28πREAD Bal4m(I)πNEXTπDIM SHARED Bal4(28)πFOR I = 1 TO 28πREAD Bal4(I)πNEXTπDIM SHARED Bal3m(28)πFOR I = 1 TO 28πREAD Bal3m(I)πNEXTπDIM SHARED Bal3(28)πFOR I = 1 TO 28πREAD Bal3(I)πNEXTπDIM SHARED Bal2m(28)πFOR I = 1 TO 28πREAD Bal2m(I)πNEXTπDIM SHARED Bal2(28)πFOR I = 1 TO 28πREAD Bal2(I)πNEXTπDIM SHARED Bal1m(28)πFOR I = 1 TO 28πREAD Bal1m(I)πNEXTπDIM SHARED Bal1(28)πFOR I = 1 TO 28πREAD Bal1(I)πNEXTπDIM SHARED Up(38)πFOR I = 1 TO 38πREAD Up(I)πNEXTπDIM SHARED Right(38)πFOR I = 1 TO 38πREAD Right(I)πNEXTπDIM SHARED Q(38)πFOR I = 1 TO 38πREAD Q(I)πNEXTπDIM SHARED Left(38)πFOR I = 1 TO 38πREAD Left(I)πNEXTπDIM SHARED F1(38)πFOR I = 1 TO 38πREAD F1(I)πNEXTπDIM SHARED Down(38)πFOR I = 1 TO 38πREAD Down(I)πNEXTπDIM SHARED Alt(38)πFOR I = 1 TO 38πREAD Alt(I)πNEXTπDIM SHARED Title(548)πFOR I = 1 TO 548πREAD Title(I)πNEXTπDIM SHARED Icon(38)πFOR I = 1 TO 38πREAD Icon(I)πNEXTπDIM SHARED Iconm(38)πFOR I = 1 TO 38πREAD Iconm(I)πNEXTπDIM SHARED Manny(380)πFOR I = 1 TO 380πREAD Manny(I)πNEXTπDIM SHARED Score(82)πFOR I = 1 TO 82πREAD Score(I)πNEXTπDIM SHARED me(2002)πFOR I = 1 TO 2002πREAD me(I)πNEXTπDIM SHARED Gop(146)πFOR I = 1 TO 146πREAD Gop(I)πNEXTπDIM SHARED Message(44) AS STRING * 39πFOR I = 1 TO 44πREAD Message(I)πNEXTπDIM SHARED G(5) AS STRINGπFOR I = 1 TO 5πREAD G(I)πNEXTπDIM SHARED Bomb1(18)πFOR I = 1 TO 18πREAD Bomb1(I)πNEXTπDIM SHARED Bomb1m(18)πFOR I = 1 TO 18πREAD Bomb1m(I)πNEXTπDIM SHARED Bomb2(18)πFOR I = 1 TO 18πREAD Bomb2(I)πNEXTπDIM SHARED Bomb2m(18)πFOR I = 1 TO 18πREAD Bomb2m(I)πNEXTπDIM SHARED Bomb3(18)πFOR I = 1 TO 18πREAD Bomb3(I)πNEXTπDIM SHARED Bomb3m(18)πFOR I = 1 TO 18πREAD Bomb3m(I)πNEXTπDIM SHARED Bomb4(18)πFOR I = 1 TO 18πREAD Bomb4(I)πNEXTπDIM SHARED Bomb4m(18)πFOR I = 1 TO 18πREAD Bomb4m(I)πNEXTπDIM SHARED Lc(164)πFOR I = 1 TO 164πREAD Lc(I)πNEXTππ'PREDSππInititππFOR I = 1 TO 60πStar(I).X = Fnr(305) + 10πStar(I).Y = Fnr(180) + 10πStar(I).T = Fnr(3)πSELECT CASE Star(I).TπCASE 1πStar(I).C = 8πCASE 2πStar(I).C = 7πCASE 3πStar(I).C = 15πEND SELECTπNEXTππ'MAIN CODEππMp = 1ππCreateTable     'Sin/Cos table... for all the explosionsππCLSπDrawArenaπSCREEN 7, 0, 1, 0     'This makes no sense at all...πMakeIntroScreenπPCOPY 1, 0πMakeInfoπMakeHelpScreenπMakeQuitsπSCREEN 7, 0, 1, 0πDoIntroπMakeTitleScreenπDoMenuππ'Here are all the graphics for the gameπ'Get statement???ππDATA &H0005,&H0007,&H8888,&H8888,&H0000,&H0000,&H0000,&H0000πDATA &H0000,&H0000,&H8888,&H8888,&HD8D8,&HD8D8,&HD8D8,&HD8D8πDATA &H0005,&H0007,&H7171,&H2171,&H88F8,&H8800,&H00F8,&H8800πDATA &H00F8,&H0000,&H7151,&H0151,&H2101,&H2101,&H2121,&H2121πDATA &H000D,&H0007,&HF8FF,&HF8FF,&H0000,&HF8FF,&H889A,&HF8FFπDATA &H7065,&HF8FF,&HA8DA,&HF8FF,&H5025,&HF8FF,&H88DA,&HF8FFπDATA &H7025,&HF8FF,&HB8DA,&HF8FF,&H4025,&HF8FF,&HB888,&HF8FFπDATA &H4077,&HF8FF,&HF8FF,&HF8FF,&H0000,&HF8FFπDATA &H000D,&H0007,&H0300,&HFBFF,&H0000,&HFBFF,&H0200,&HFBFFπDATA &H7177,&HFBFF,&H0300,&HFBFF,&H5045,&HFBFF,&H0300,&HFBFFπDATA &H5075,&HFBFF,&H0300,&HFBFF,&H5015,&HFBFF,&H0200,&HFBFFπDATA &H7177,&HFBFF,&H0300,&HFBFF,&H0000,&HFBFFπDATA &H000D,&H0007,&HF8FF,&H0000,&H0000,&HF8FF,&H8898,&H7067πDATA &H7067,&HF8FF,&HA8DA,&H5025,&H5025,&HF8FF,&HA8DA,&H5025πDATA &H5025,&HF8FF,&HA8DA,&H5025,&H5025,&HF8FF,&H8888,&H7077πDATA &H7077,&HF8FF,&HF8FF,&H0000,&H0000,&HF8FFπDATA &H0009,&H0005,&H801F,&H801F,&H801F,&H801F,&H8086,&H8086πDATA &H8086,&H8086,&H0000,&H0000,&H0000,&H0000,&H8386,&H8386πDATA &H8386,&H8386,&H821F,&H821F,&H821F,&H821FπDATA &H0009,&H0005,&H00E0,&H0080,&H0000,&H00C0,&H0001,&H0000πDATA &H0058,&H0029,&H8061,&H81E1,&H81EF,&H00D2,&H0001,&H0100πDATA &H0158,&H0229,&H00E0,&H0180,&H0100,&H02C0πDATA &H0009,&H0005,&H03FC,&H03FC,&H03FC,&H03FC,&H90B0,&H90B0πDATA &H90B0,&H90B0,&H0000,&H0000,&H0000,&H0000,&H90B0,&H90B0πDATA &H90B0,&H90B0,&H03FC,&H03FC,&H03FC,&H03FCπDATA &H0009,&H0005,&H9C03,&H9000,&H0000,&H9801,&H0040,&H0000πDATA &H0B0D,&H054A,&H0CC3,&H9CC3,&H9DFB,&H9A25,&H0040,&H0000πDATA &H0B0D,&H054A,&H9C03,&H9000,&H0000,&H9801πDATA &H0007,&H0007,&HFEFE,&HFEFE,&HFEFE,&HFEFE,&H8282,&H8282πDATA &H0000,&H0000,&H8282,&H8282,&HFEFE,&HFEFE,&HFEFE,&HFEFEπDATA &H0007,&H0007,&H0000,&H0000,&H0000,&H0000,&H7C7C,&H007CπDATA &H7E02,&H807E,&H0000,&H7C00,&H0000,&H0000,&H0000,&H0000πDATA &H0007,&H0007,&HFEFE,&HFEFE,&HC6C6,&HC6C6,&H8282,&H8282πDATA &H0000,&H0000,&H8282,&H8282,&HC6C6,&HC6C6,&HFEFE,&HFEFEπDATA &H0007,&H0007,&H0000,&H0000,&H3838,&H0038,&H7C04,&H007CπDATA &H7E02,&H807E,&H3C00,&H403C,&H0000,&H3800,&H0000,&H0000πDATA &H0007,&H0007,&HC6C6,&HC6C6,&H8282,&H8282,&H0000,&H0000πDATA &H0000,&H0000,&H0000,&H0000,&H8282,&H8282,&HC6C6,&HC6C6πDATA &H0007,&H0007,&H3838,&H0038,&H7C04,&H007C,&H7E02,&H807EπDATA &H7E02,&H807E,&H7E02,&H807E,&H3C00,&H403C,&H0000,&H3800πDATA &H0007,&H000D,&HC6C6,&HC6C6,&H8282,&H8282,&H0000,&H0000πDATA &H0000,&H0000,&H0000,&H0000,&H8282,&H8282,&HC6C6,&HC6C6πDATA &HEEEE,&HEEEE,&HEEEE,&HEEEE,&HEEEE,&HEEEE,&HF6F6,&HF6F6πDATA &HF6F6,&HF6F6,&HFAFA,&HFAFAπDATA &H0007,&H000D,&H0000,&H0038,&H0000,&H187C,&H0000,&H04FEπDATA &H0000,&H00FE,&H0000,&H00FE,&H0000,&H007C,&H0000,&H0038πDATA &H1010,&H0010,&H1010,&H0010,&H1010,&H0010,&H0808,&H0008πDATA &H0808,&H0008,&H0404,&H0004πDATA &H0007,&H000D,&HC6C6,&HC6C6,&H8282,&H8282,&H0000,&H0000πDATA &H0000,&H0000,&H0000,&H0000,&H8282,&H8282,&HC6C6,&HC6C6πDATA &HEEEE,&HEEEE,&HEEEE,&HEEEE,&HEEEE,&HEEEE,&HF6F6,&HF6F6πDATA &HF6F6,&HF6F6,&HF6F6,&HF6F6πDATA &H0007,&H000D,&H0000,&H0038,&H0000,&H087C,&H0000,&H04FEπDATA &H0000,&H00FE,&H0000,&H00FE,&H0000,&H007C,&H0000,&H0038πDATA &H1010,&H0010,&H1010,&H0010,&H1010,&H0010,&H0808,&H0008πDATA &H0808,&H0008,&H0808,&H0008πDATA &H0007,&H000D,&HC6C6,&HC6C6,&H8282,&H8282,&H0000,&H0000πDATA &H0000,&H0000,&H0000,&H0000,&H8282,&H8282,&HC6C6,&HC6C6πDATA &HEEEE,&HEEEE,&HEEEE,&HEEEE,&HEEEE,&HEEEE,&HEEEE,&HEEEEπDATA &HEEEE,&HEEEE,&HEEEE,&HEEEEπDATA &H0007,&H000D,&H0000,&H0038,&H0000,&H087C,&H0000,&H04FEπDATA &H0000,&H04FE,&H0000,&H00FE,&H0000,&H007C,&H0000,&H0038πDATA &H1010,&H0010,&H1010,&H0010,&H1010,&H0010,&H1010,&H0010πDATA &H1010,&H0010,&H1010,&H0010πDATA &H0007,&H000D,&HC6C6,&HC6C6,&H8282,&H8282,&H0000,&H0000πDATA &H0000,&H0000,&H0000,&H0000,&H8282,&H8282,&HC6C6,&HC6C6πDATA &HEEEE,&HEEEE,&HEEEE,&HEEEE,&HEEEE,&HEEEE,&HDEDE,&HDEDEπDATA &HDEDE,&HDEDE,&HDEDE,&HDEDEπDATA &H0007,&H000D,&H0000,&H0038,&H0000,&H087C,&H0000,&H04FEπDATA &H0000,&H00FE,&H0000,&H00FE,&H0000,&H007C,&H0000,&H0038πDATA &H1010,&H0010,&H1010,&H0010,&H1010,&H0010,&H2020,&H0020πDATA &H2020,&H0020,&H2020,&H0020πDATA &H0007,&H000D,&HC6C6,&HC6C6,&H8282,&H8282,&H0000,&H0000πDATA &H0000,&H0000,&H0000,&H0000,&H8282,&H8282,&HC6C6,&HC6C6πDATA &HEEEE,&HEEEE,&HEEEE,&HEEEE,&HEEEE,&HEEEE,&HDEDE,&HDEDEπDATA &HDEDE,&HDEDE,&HBEBE,&HBEBEπDATA &H0007,&H000D,&H0000,&H0038,&H0000,&H187C,&H0000,&H04FEπDATA &H0000,&H00FE,&H0000,&H00FE,&H0000,&H007C,&H0000,&H0038πDATA &H1010,&H0010,&H1010,&H0010,&H1010,&H0010,&H2020,&H0020πDATA &H2020,&H0020,&H4040,&H0040πDATA &H0009,&H0009,&H80FF,&H80FF,&H80FF,&H00FF,&H00FF,&H00FFπDATA &H00FF,&H8080,&H00F7,&H00F7,&H00F7,&H8080,&H00E3,&H00E3πDATA &H00E3,&H8080,&H00C1,&H00C1,&H00C1,&H8080,&H00F7,&H00F7πDATA &H00F7,&H8080,&H00F7,&H00F7,&H00F7,&H8080,&H00FF,&H00FFπDATA &H00FF,&H8080,&H0080,&H0080,&H0080,&H807FπDATA &H0009,&H0009,&H80FF,&H80FF,&H80FF,&H00FF,&H00FF,&H00FFπDATA &H00FF,&H8080,&H00F7,&H00F7,&H00F7,&H8080,&H00F3,&H00F3πDATA &H00F3,&H8080,&H00C1,&H00C1,&H00C1,&H8080,&H00F3,&H00F3πDATA &H00F3,&H8080,&H00F7,&H00F7,&H00F7,&H8080,&H00FF,&H00FFπDATA &H00FF,&H8080,&H0080,&H0080,&H0080,&H807FπDATA &H0009,&H0009,&H80FF,&H80FF,&H80FF,&H00FF,&H00FF,&H00FFπDATA &H00FF,&H8080,&H00E3,&H00E3,&H00E3,&H8080,&H00DD,&H00DDπDATA &H00DD,&H8080,&H00DD,&H00DD,&H00DD,&H8080,&H00D9,&H00D9πDATA &H00D9,&H8080,&H00E1,&H00E1,&H00E1,&H8080,&H00FF,&H00FFπDATA &H00FF,&H8080,&H0080,&H0080,&H0080,&H807FπDATA &H0009,&H0009,&H80FF,&H80FF,&H80FF,&H00FF,&H00FF,&H00FFπDATA &H00FF,&H8080,&H00F7,&H00F7,&H00F7,&H8080,&H00E7,&H00E7πDATA &H00E7,&H8080,&H00C1,&H00C1,&H00C1,&H8080,&H00E7,&H00E7πDATA &H00E7,&H8080,&H00F7,&H00F7,&H00F7,&H8080,&H00FF,&H00FFπDATA &H00FF,&H8080,&H0080,&H0080,&H0080,&H807FπDATA &H0009,&H0009,&H80FF,&H80FF,&H80FF,&H00FF,&H00FF,&H00FFπDATA &H00FF,&H8080,&H00C5,&H00C5,&H00C5,&H8080,&H00DD,&H00DDπDATA &H00DD,&H8080,&H00CD,&H00CD,&H00CD,&H8080,&H00DD,&H00DDπDATA &H00DD,&H8080,&H00DD,&H00DD,&H00DD,&H8080,&H00FF,&H00FFπDATA &H00FF,&H8080,&H0080,&H0080,&H0080,&H807FπDATA &H0009,&H0009,&H80FF,&H80FF,&H80FF,&H00FF,&H00FF,&H00FFπDATA &H00FF,&H8080,&H00F7,&H00F7,&H00F7,&H8080,&H00F7,&H00F7πDATA &H00F7,&H8080,&H00C1,&H00C1,&H00C1,&H8080,&H00E3,&H00E3πDATA &H00E3,&H8080,&H00F7,&H00F7,&H00F7,&H8080,&H00FF,&H00FFπDATA &H00FF,&H8080,&H0080,&H0080,&H0080,&H807FπDATA &H000D,&H0009,&HF8FF,&HF8FF,&HF8FF,&HF0FF,&HF0FF,&HF0FFπDATA &HF0FF,&H0880,&HB0ED,&HB0ED,&HB0ED,&H0880,&H10D5,&H10D5πDATA &H10D5,&H0880,&HB0C5,&HB0C5,&HB0C5,&H0880,&HB0D5,&HB0D5πDATA &HB0D5,&H0880,&H90D5,&H90D5,&H90D5,&H0880,&HF0FF,&HF0FFπDATA &HF0FF,&H0880,&H0080,&H0080,&H0080,&HF87FπDATA  &H0063,&H0015,&H0000,&H0000,&H0000,&H0000,&H0000,&H0000,&H0000,&H0000πDATA  &H0000,&H0000,&H0000,&H0000,&H0000,&H0000,&H0000,&H0000,&H0000,&H0000πDATA  &H0000,&H0000,&H0000,&H0000,&H0000,&H0000,&H0000,&H0000,&HFF7F,&H0000πDATA  &H0077,&H0000,&H0000,&H0107,&H00C0,&H0000,&H0000,&H0000,&H0000,&H0000πDATA  &H0000,&H0000,&H0000,&H0000,&H0000,&H0000,&H0000,&H7F00,&H00FF,&H7700πDATA  &H0000,&H0000,&H0700,&HC001,&HFF7F,&H0080,&H0077,&H0000,&H0000,&H0107πDATA  &H00C0,&H0000,&H0000,&H0000,&H0000,&H0000,&H0000,&H0000,&H0000,&H0000πDATA  &H0000,&H0000,&H0000,&H7F00,&H80FF,&H7700,&H0000,&H0000,&H0700,&HC001πDATA  &HFF7F,&H00C0,&H0077,&H0000,&H0000,&H0107,&H00C0,&H0000,&H0000,&H0000πDATA  &H0000,&H0000,&H0000,&H0000,&H0000,&H0000,&H0000,&H0000,&H0000,&H7F00πDATA  &HC0FF,&H7700,&H0000,&H0000,&H0700,&HC001,&H0070,&H00E0,&H0077,&H0000πDATA  &H0000,&H0107,&H00C0,&H0000,&H0000,&H0000,&H0000,&H0000,&H0000,&H0000πDATA  &H0000,&H0000,&H0000,&H0000,&H0000,&H7000,&HE000,&H7700,&H0000,&H0000πDATA  &H0700,&HC001,&H0070,&H00E0,&H0077,&H0000,&H0000,&H0107,&H00C0,&H0000πDATA  &H0000,&H0000,&H0000,&H0000,&H0000,&H0000,&H0000,&H0000,&H0000,&H0000πDATA  &H0000,&H7000,&HE000,&H7700,&H0000,&H0000,&H0700,&HC001,&H0070,&HFFE1πDATA  &H1F77,&HFCC1,&HE07F,&H8307,&H00C0,&H0000,&H0000,&H0000,&H0000,&H0000πDATA  &H0000,&H0000,&H0000,&H0000,&H0000,&H0000,&H0000,&H7000,&HE100,&H77FFπDATA  &HC11F,&H7FFC,&H07E0,&HC083,&H0070,&HFFE3,&H3F77,&HFEE3,&HF07F,&HC703πDATA  &H0080,&H0000,&H0000,&H0000,&H0000,&H0000,&H0000,&H0000,&H0000,&H0000πDATA  &H0000,&H0000,&H0000,&H7000,&HE300,&H77FF,&HE33F,&H7FFE,&H03F0,&H80C7πDATA  &HFF71,&HFF87,&H7F77,&HFFF7,&HF87F,&HEF01,&H0000,&H0000,&H0000,&H0000πDATA  &H0000,&H0000,&H0000,&H0000,&H0000,&H0000,&H0000,&H0000,&H0000,&H7100πDATA  &H87FF,&H77FF,&HF77F,&H7FFF,&H01F8,&H00EF,&HFF71,&H078E,&H7077,&H0777πDATA  &H3870,&HFE00,&H0000,&H0000,&H0000,&H0000,&H0000,&H0000,&H0000,&H0000πDATA  &H0000,&H0000,&H0000,&H0000,&H0000,&H7100,&H8EFF,&H7707,&H7770,&H7007πDATA  &H0038,&H00FE,&H0070,&H07EE,&H7077,&H0777,&H3870,&H7C00,&H0000,&H0000πDATA  &H0000,&H0000,&H0000,&H0000,&H0000,&H0000,&H0000,&H0000,&H0000,&H0000πDATA  &H0000,&H7000,&HEE00,&H7707,&H7770,&H7007,&H0038,&H007C,&H0070,&H07EEπDATA  &H7077,&H0777,&H3870,&HFE00,&H0000,&H0000,&H0000,&H0000,&H0000,&H0000πDATA  &H0000,&H0000,&H0000,&H0000,&H0000,&H0000,&H0000,&H7000,&HEE00,&H7707πDATA  &H7770,&H7007,&H0038,&H00FE,&H0070,&H07EE,&H7077,&H0777,&H3870,&HEF01πDATA  &H0000,&H0000,&H0000,&H0000,&H0000,&H0000,&H0000,&H0000,&H0000,&H0000πDATA  &H0000,&H0000,&H0000,&H7000,&HEE00,&H7707,&H7770,&H7007,&H0138,&H00EFπDATA  &H0070,&H07EE,&H7077,&H0777,&H3870,&HC703,&H0080,&H0000,&H0000,&H0000πDATA  &H0000,&H0000,&H0000,&H0000,&H0000,&H0000,&H0000,&H0000,&H0000,&H7000πDATA  &HEE00,&H7707,&H7770,&H7007,&H0338,&H80C7,&H0070,&H07EE,&H7077,&H0777πDATA  &H3870,&H8307,&H00C0,&H0000,&H0000,&H0000,&H0000,&H0000,&H0000,&H0000πDATA  &H0000,&H0000,&H0000,&H0000,&H0000,&H7000,&HEE00,&H7707,&H7770,&H7007πDATA  &H0738,&HC083,&H0070,&H07EE,&H7077,&H0777,&H3870,&H0107,&H00C0,&H0000πDATA  &H0000,&H0000,&H0000,&H0000,&H0000,&H0000,&H0000,&H0000,&H0000,&H0000πDATA  &H0000,&H7000,&HEE00,&H7707,&H7770,&H7007,&H0738,&HC001,&H0070,&H07EEπDATA  &H7077,&H0777,&H3870,&H0107,&H00C0,&H0000,&H0000,&H0000,&H0000,&H0000πDATA  &H0000,&H0000,&H0000,&H0000,&H0000,&H0000,&H0000,&H7000,&HEE00,&H7707πDATA  &H7770,&H7007,&H0738,&HC001,&HFF71,&HE7CF,&H7077,&H0777,&H3870,&H0107πDATA  &H00C0,&H0000,&H0000,&H0000,&H0000,&H0000,&H0000,&H0000,&H0000,&H0000πDATA  &H0000,&H0000,&H0000,&H7100,&HCFFF,&H77E7,&H7770,&H7007,&H0738,&HC001πDATA  &HFF71,&HE787,&H7F77,&HFFF7,&H3870,&H0107,&H00C0,&H0000,&H0000,&H0000πDATA  &H0000,&H0000,&H0000,&H0000,&H0000,&H0000,&H0000,&H0000,&H0000,&H7100πDATA  &H87FF,&H77E7,&HF77F,&H70FF,&H0738,&HC001,&HFF71,&HE703,&H3F77,&HFEE3πDATA  &H3870,&H0107,&H00C0,&H0000,&H0000,&H0000,&H0000,&H0000,&H0000,&H0000πDATA  &H0000,&H0000,&H0000,&H0000,&H0000,&H7100,&H03FF,&H77E7,&HE33F,&H70FEπDATA  &H0738,&HC001,&H0000,&H0000,&H1F00,&HFCC1,&H0000,&H0000,&H0000,&H0000πDATA  &H0000,&H0000,&H0000,&H0000,&H0000,&H0000,&H0000,&H0000,&H0000,&H0000πDATA  &H0000,&H0000,&H0000,&H0000,&HC11F,&H00FC,&H0000,&H0000πDATA &H0009,&H0009,&H001C,&H0000,&H0000,&H0000,&H007F,&H0000πDATA &H0000,&H0000,&H007F,&H0000,&H0000,&H001C,&H80FF,&H0008πDATA &H0000,&H003E,&H80FF,&H001C,&H0008,&H003E,&H80FF,&H0008πDATA &H0000,&H003E,&H007F,&H0000,&H0000,&H001C,&H007F,&H0000πDATA &H0000,&H0000,&H001C,&H0000,&H0000,&H0000πDATA &H0009,&H0009,&H80E3,&H80E3,&H80E3,&H80E3,&H8080,&H8080πDATA &H8080,&H8080,&H8080,&H8080,&H8080,&H8080,&H0000,&H0000πDATA &H0000,&H0000,&H0000,&H0000,&H0000,&H0000,&H0000,&H0000πDATA &H0000,&H0000,&H8080,&H8080,&H8080,&H8080,&H8080,&H8080πDATA &H8080,&H8080,&H80E3,&H80E3,&H80E3,&H80E3πDATA &H0036,&H001B,&HFFFF,&HFFFF,&HFFFF,&HFFFC,&HFFFF,&HFFFFπDATA &HF8FF,&H0000,&H0000,&H0000,&HFF00,&HFFFF,&HFFFF,&HFCFFπDATA &HFFFF,&HFFFF,&HFFFF,&H80FC,&H0000,&H0000,&H0000,&H0000πDATA &H0000,&H0000,&HFF00,&HFFFF,&HFFFF,&HF8FF,&HFFFF,&HFFFFπDATA &HFFFF,&H80FC,&H0000,&H0000,&H0000,&H0000,&H0000,&H0000πDATA &HFF00,&HFFFF,&HFFFF,&HF8FF,&HFFFF,&HFFFF,&HFFFF,&H80FCπDATA &H0000,&H0000,&H0000,&H0000,&H0000,&H0000,&HFF00,&HFFFFπDATA &HFFFF,&HF8FF,&HFFFF,&HCCE1,&HCCCC,&H87FC,&H000E,&H0000πDATA &H0000,&H0E07,&H331E,&H3333,&HF800,&HFFF1,&HFFFF,&HF8FFπDATA &H70FC,&HCCC0,&HCCCC,&H84FC,&H0000,&H0000,&H0000,&H8F07πDATA &H333F,&H3333,&HFB00,&HFF7E,&HFFFF,&HF8FF,&H30FC,&HC4CCπDATA &HCCC4,&H84FC,&H0010,&H0000,&H0000,&HDF07,&H3B33,&H333BπDATA &HFB00,&HFFAE,&HFFFF,&HF8FF,&H30FC,&HC4CC,&HE1C4,&H84FCπDATA &H0010,&H0000,&H0000,&HDF07,&H3B33,&H1E3B,&HFB00,&HFFAEπDATA &HFFFF,&HF8FF,&H30FC,&HC8C0,&HE1C8,&H84FC,&H0010,&H0000πDATA &H0000,&HDF07,&H373F,&H1E37,&HFB00,&HFFAE,&HFFFF,&HF8FFπDATA &H00FC,&HC8CC,&HF3C8,&H84FC,&H0000,&H0000,&H0000,&HFF07πDATA &H3733,&H0C37,&HFB00,&HFFFE,&HFFFF,&HF8FF,&H00FC,&HC8CCπDATA &HF3C8,&H84FC,&H0000,&H0000,&H0000,&HFF07,&H3733,&H0C37πDATA &HFB00,&HFFFE,&HFFFF,&HF8FF,&H00FC,&HCCCC,&HF3CC,&H84FCπDATA &H0000,&H0000,&H0000,&HFF07,&H3333,&H0C33,&HFB00,&HFFFEπDATA &HFFFF,&HF8FF,&HCCFC,&HCCCC,&HF3CC,&H84FC,&H0044,&H0000πDATA &H0000,&H7707,&H3333,&H0C33,&HFA00,&HFFAA,&HFFFF,&HF8FFπDATA &HCCFC,&HFFFF,&HFFFF,&H84FC,&H0044,&H0000,&H0000,&H7707πDATA &H0000,&H0000,&HFA00,&HFFAA,&HFFFF,&HF8FF,&HCCFC,&HC3E1πDATA &HFFC0,&H84FC,&H0044,&H0000,&H0000,&H7707,&H3C1E,&H003FπDATA &HFA00,&HFFAA,&HFFFF,&HF8FF,&HDCFC,&HC1C0,&HFFC0,&H84FCπDATA &H0004,&H0000,&H0000,&H2707,&H3E3F,&H003F,&HFA00,&HFFDAπDATA &HFFFF,&HF8FF,&HFCFC,&HCCCC,&HFFCF,&H84FC,&H0004,&H0000πDATA &H0000,&H0707,&H3333,&H0030,&HFA00,&HFFFA,&HFFFF,&HF8FFπDATA &HFCFC,&HCCCC,&HFFCF,&H84FC,&H0004,&H0000,&H0000,&H0707πDATA &H3333,&H0030,&HFA00,&HFFFA,&HFFFF,&HF8FF,&HFCFC,&HCCC0πDATA &HFFC3,&H84FC,&H0004,&H0000,&H0000,&H0707,&H333F,&H003CπDATA &HFA00,&HFFFA,&HFFFF,&HF8FF,&HFCFC,&HCCCC,&HFFCF,&H84FCπDATA &H0004,&H0000,&H0000,&H0707,&H3333,&H0030,&HFA00,&HFFFAπDATA &HFFFF,&HF8FF,&HFCFC,&HCCCC,&HFFCF,&H84FC,&H0004,&H0000πDATA &H0000,&H0707,&H3333,&H0030,&HFA00,&HFFFA,&HFFFF,&HF8FFπDATA &HFCFC,&HC1CC,&HFFC0,&H84FC,&H0004,&H0000,&H0000,&H0707πDATA &H3E33,&H003F,&HFA00,&HFFFA,&HFFFF,&HF8FF,&HF8F8,&HC3CCπDATA &HFFC0,&H80FC,&H0000,&H0000,&H0000,&H0707,&H3C33,&H003FπDATA &HF800,&HFFF8,&HFFFF,&HF8FF,&HFFFF,&HFFFF,&HFFFF,&H80FCπDATA &H0000,&H0000,&H0000,&H0000,&H0000,&H0000,&HFF00,&HFFFFπDATA &HFFFF,&HF8FF,&HFFFF,&HFFFF,&HFFFF,&H80FC,&H0000,&H0000πDATA &H0000,&H0000,&H0000,&H0000,&HFF00,&HFFFF,&HFFFF,&HF8FFπDATA &HFFFF,&HFFFF,&HFFFF,&H80FC,&H0000,&H0000,&H0000,&H0000πDATA &H0000,&H0000,&HFF00,&HFFFF,&HFFFF,&HF8FF,&HFFFF,&HFFFFπDATA &HFFFF,&H00FC,&H0000,&H0000,&H0000,&H0000,&H0000,&H0000πDATA &H8000,&H0000,&H0000,&H0000πDATA &H0022,&H0008,&HE779,&H783C,&H0000,&H0000,&H0000,&H0000πDATA &H0000,&H7900,&H3CE7,&H0078,&HEFFB,&HF8BE,&H0000,&H0000πDATA &H0000,&H0000,&H0000,&HFB00,&HBEEF,&H00F8,&H0DC3,&HC0B6πDATA &H0000,&H0000,&H0000,&H0000,&H0000,&HC300,&HB60D,&H00C0πDATA &H0DE3,&HE1BC,&H00C0,&H0000,&H0000,&H0000,&H0000,&HE300πDATA &HBC0D,&HC0E1,&H0D7B,&HE1B6,&H00C0,&H0000,&H0000,&H0000πDATA &H0000,&H7B00,&HB60D,&HC0E1,&H0D1B,&HC0B6,&H0000,&H0000πDATA &H0000,&H0000,&H0000,&H1B00,&HB60D,&H00C0,&HEFFB,&HF8B6πDATA &H0000,&H0000,&H0000,&H0000,&H0000,&HFB00,&HB6EF,&H00F8πDATA &HE7F1,&H7836,&H0000,&H0000,&H0000,&H0000,&H0000,&HF100πDATA &H36E7,&H0078πDATA &H0050,&H0064,&HDD5D,&H05C0,&H00C0,&H0000,&H0000,&HDD5DπDATA &H05C0,&H00C0,&H0000,&H0000,&HDD5D,&H05C0,&H00C0,&H0000πDATA &H0000,&H22A2,&H5A3D,&H5530,&H45D5,&H15C0,&HFFAF,&H0E80πDATA &H0080,&H0000,&H0000,&HFFAF,&H0E80,&H0080,&H0000,&H0000πDATA &HFFAF,&H0E80,&H0080,&H0000,&H0000,&H0050,&HF17E,&HAA68πDATA &HABBB,&H2AA0,&HFF57,&H0000,&H0000,&H0000,&H0000,&HFF57πDATA &H0000,&H0000,&H0000,&H0000,&HFF57,&H0000,&H0000,&H0000πDATA &H0000,&H00A8,&H5FFD,&H00C0,&H5515,&H1140,&HFEBF,&H08A8πDATA &H0000,&H0000,&H0000,&HFEBF,&H08A8,&H0000,&H0000,&H0000πDATA &HFEBF,&H08A8,&H0000,&H0000,&H0000,&HA940,&HF757,&H0088πDATA &HAF0A,&H2AE0,&HFF5D,&H0040,&H0000,&H0000,&H0000,&HFF5DπDATA &H0040,&H0000,&H0000,&H0000,&HFF5D,&H0040,&H0000,&H0000πDATA &H0000,&H50A2,&H7DBD,&H0000,&H5D00,&H5440,&HFFAF,&H00A0πDATA &H0000,&H0000,&H0000,&HFFAF,&H00A0,&H0000,&H0000,&H0000πDATA &HFFAF,&H00A0,&H0000,&H0000,&H0000,&H2A52,&H285E,&H0000πDATA &H2F00,&H2AA0,&HFF57,&H0040,&H0000,&H0000,&H0000,&HFF57πDATA &H0040,&H0000,&H0000,&H0000,&HFF57,&H0040,&H0000,&H0000πDATA &H0000,&H00A8,&H00B4,&H0000,&H0500,&H1140,&HFFEF,&H00E0πDATA &H0000,&H0000,&H0000,&HFFEF,&H00E0,&H0000,&H0000,&H0000πDATA &HFFEF,&H00E0,&H0000,&H0000,&H0000,&HA812,&H0018,&H0000πDATA &H0000,&HAAE2,&HFF5F,&H0040,&H0000,&H0000,&H0000,&HFF5FπDATA &H0040,&H0000,&H0000,&H0000,&HFF5F,&H0040,&H0000,&H0000πDATA &H0000,&H00A0,&H00B0,&H0000,&H0000,&H4440,&HFFBF,&H0080πDATA &H0000,&H0000,&H0000,&HFFBF,&H0080,&H0000,&H0000,&H0000πDATA &HFFBF,&H0080,&H0000,&H0000,&H0000,&H2040,&H0060,&H0000πDATA &H0000,&HAA22,&HFDF7,&H0000,&H0000,&H0000,&H0000,&HFDF7πDATA &H0000,&H0000,&H0000,&H0000,&HFDF7,&H0000,&H0000,&H0000πDATA &H0000,&H0208,&H00C0,&H0000,&H0000,&H5001,&HFEFF,&H0080πDATA &H0000,&H0000,&H0000,&HFEFF,&H0080,&H0000,&H0000,&H0000πDATA &HFEFF,&H0080,&H0000,&H0000,&H0000,&H0900,&H0000,&H0000πDATA &H0000,&HAA02,&HFCFD,&H0000,&H0000,&H0000,&H0000,&HFCFDπDATA &H0000,&H0000,&H0000,&H0000,&HFCFD,&H0000,&H0000,&H0000πDATA &H0000,&H0302,&H0000,&H0000,&H0000,&H5401,&HF8FF,&H0000πDATA &H0000,&H0000,&H0000,&HF8FF,&H0000,&H0000,&H0000,&H0000πDATA &HF8FF,&H0000,&H0000,&H0000,&H0000,&H0600,&H0000,&H0000πDATA &H0000,&HAA02,&H40F5,&H0000,&H0000,&H0000,&H0000,&H40F5πDATA &H0000,&H0000,&H0000,&H0000,&H40F5,&H0000,&H0000,&H0000πDATA &H0000,&HBC0A,&H0000,&H0000,&H0000,&H1501,&H00E8,&H0000πDATA &H0000,&H0000,&H0000,&H00E8,&H0000,&H0000,&H0000,&H0000πDATA &H00E8,&H0000,&H0000,&H0000,&H0000,&HF817,&H0000,&H0000πDATA &H0000,&HAA00,&H4040,&H0000,&H0000,&H0000,&H0000,&H4040πDATA &H0000,&H0000,&H0000,&H0000,&H4040,&H0000,&H0000,&H0000πDATA &H0000,&HB0B5,&H0000,&H0000,&H0000,&H5400,&HA0A2,&H0000πDATA &H0000,&H0000,&H0000,&HA0A2,&H0000,&H0000,&H0000,&H0000πDATA &HA0A2,&H0000,&H0000,&H0000,&H0000,&H405D,&H0000,&H0000πDATA &H0000,&HAA00,&H0000,&H0000,&H0000,&H0000,&H0000,&H0000πDATA &H0000,&H0000,&H0000,&H0000,&H0000,&H0000,&H0000,&H0000πDATA &H0000,&HC0FF,&H0000,&H0000,&H0000,&H1000,&H00BE,&H0000πDATA &H0000,&H0000,&H0000,&H00BE,&H0000,&H0000,&H0000,&H0000πDATA &H00BE,&H0000,&H0000,&H0000,&H0000,&HC041,&H0000,&H0000πDATA &H0000,&HAA00,&H00F4,&H0000,&H0000,&H0000,&H0000,&H00F4πDATA &H0000,&H0000,&H0000,&H0000,&H00F4,&H0000,&H0000,&H0000πDATA &H0000,&H800B,&H0000,&H0000,&H0000,&H1400,&H00F8,&H0000πDATA &H0000,&H0000,&H0000,&H00F8,&H0000,&H0000,&H0000,&H0000πDATA &H00F8,&H0000,&H0000,&H0000,&H0000,&H8007,&H0000,&H0000πDATA &H0000,&H2A00,&H0074,&H0000,&H0000,&H0000,&H0000,&H0074πDATA &H0000,&H0000,&H0000,&H0000,&H0074,&H0000,&H0000,&H0000πDATA &H0000,&H008B,&H0000,&H0000,&H0000,&H0000,&H00FC,&H0000πDATA &H0000,&H0000,&H0000,&H00FC,&H0000,&H0000,&H0000,&H0000πDATA &H00FC,&H0000,&H0000,&H0000,&H0000,&H8003,&H0000,&H0000πDATA &H0000,&H2A00,&H00FC,&H0000,&H0000,&H0000,&H0000,&H00FCπDATA &H0000,&H0000,&H0000,&H0000,&H00FC,&H0000,&H0000,&H0000πDATA &H0000,&H0002,&H0400,&H0000,&H0000,&H0400,&H00FE,&H0000πDATA &H0000,&H0000,&H0000,&H00FE,&H0000,&H0000,&H0000,&H0000πDATA &H00FE,&H0000,&H0000,&H0000,&H0000,&H0020,&HAA02,&H0080πDATA &H0000,&H0A00,&H00F4,&H0000,&H0000,&H0000,&H0000,&H00F4πDATA &H0000,&H0000,&H0000,&H0000,&H00F4,&H0000,&H0000,&H0000πDATA &H0000,&H000A,&H5501,&H0040,&H0000,&H0100,&H00FC,&H0000πDATA &H0000,&H0000,&H0000,&H00FC,&H0000,&H0000,&H0000,&H0000πDATA &H00FC,&H0000,&H0000,&H0000,&H0000,&H0082,&HFF0F,&H00E8πDATA &H0000,&H0A00,&H00FC,&H0000,&H0000,&H0000,&H0000,&H00FCπDATA &H0000,&H0000,&H0000,&H0000,&H00FC,&H0000,&H0000,&H0000πDATA &H0000,&H0000,&HFF05,&H00FC,&H0000,&H0400,&H00F8,&H0200πDATA &H00A0,&H0000,&H0000,&H00F8,&H0200,&H00A0,&H0000,&H0000πDATA &H00F8,&H0200,&H00A0,&H0000,&H0000,&H0026,&HFD2F,&H005EπDATA &H0000,&H0A00,&H00F0,&H0100,&H0000,&H0000,&H0000,&H00F0πDATA &H0100,&H0000,&H0000,&H0000,&H00F0,&H0100,&H0000,&H0000πDATA &H0000,&H000C,&HFE17,&H00FE,&H0000,&H0100,&H00F8,&HAA00πDATA &H00E8,&H0000,&H0000,&H00F8,&HAA00,&H00E8,&H0000,&H0000πDATA &H00F8,&HAA00,&H00E8,&H0000,&H0000,&H0004,&H55BF,&H8016πDATA &H0000,&H0200,&H0040,&H5500,&H0050,&H0000,&H0000,&H0040πDATA &H5500,&H0050,&H0000,&H0000,&H0040,&H5500,&H0050,&H0000πDATA &H0000,&H00BC,&HAA5F,&H00AF,&H0000,&H0400,&H00A0,&HAA02πDATA &H00FA,&H0000,&H0000,&H00A0,&HAA02,&H00FA,&H0000,&H0000πDATA &H00A0,&HAA02,&H00FA,&H0000,&H0000,&H0058,&H55BD,&H8005πDATA &H0000,&H0200,&H0000,&H1500,&H0054,&H0000,&H0000,&H0000πDATA &H1500,&H0054,&H0000,&H0000,&H0000,&H1500,&H0054,&H0000πDATA &H0000,&H0054,&HEA5F,&H00AB,&H0000,&H0100,&H00E8,&HAF0AπDATA &H00EE,&H0000,&H0000,&H00E8,&HAF0A,&H00EE,&H0000,&H0000πDATA &H00E8,&HAF0A,&H00EE,&H0000,&H0000,&H0014,&H50B5,&H8011πDATA &H0000,&H0200,&H00D0,&H5500,&H0054,&H0000,&H0000,&H00D0πDATA &H5500,&H0054,&H0000,&H0000,&H00D0,&H5500,&H0054,&H0000πDATA &H0000,&H002C,&HAA5F,&H80AB,&H0000,&H0400,&H00F8,&HAB02πDATA &H00FA,&H0000,&H0000,&H00F8,&HAB02,&H00FA,&H0000,&H0000πDATA &H00F8,&HAB02,&H00FA,&H0000,&H0000,&H0000,&H54BD,&H8005πDATA &H0000,&H0200,&H00F0,&H1501,&H0055,&H0000,&H0000,&H00F0πDATA &H1501,&H0055,&H0000,&H0000,&H00F0,&H1501,&H0055,&H0000πDATA &H0000,&H000C,&HEA7E,&HC0AA,&H0000,&H0100,&H00F8,&HAF02πDATA &H80FE,&H0000,&H0000,&H00F8,&HAF02,&H80FE,&H0000,&H0000πDATA &H00F8,&HAF02,&H80FE,&H0000,&H0000,&H0080,&H50FD,&H6001πDATA &H0000,&H0200,&H00F0,&H5500,&H40FC,&H0000,&H0000,&H00F0πDATA &H5500,&H40FC,&H0000,&H0000,&H00F0,&H5500,&H40FC,&H0000πDATA &H0000,&H0008,&HAA5F,&H8003,&H0000,&H0000,&H00F8,&HAB02πDATA &H00FA,&H0000,&H0000,&H00F8,&HAB02,&H00FA,&H0000,&H0000πDATA &H00F8,&HAB02,&H00FA,&H0000,&H0000,&H0200,&H54BD,&HE005πDATA &H0000,&H0A00,&H00F0,&H1500,&H0055,&H0000,&H0000,&H00F0πDATA &H1500,&H0055,&H0000,&H0000,&H00F0,&H1500,&H0055,&H0000πDATA &H0000,&H000C,&HEA5F,&HF0AA,&H0000,&H0100,&H00F8,&HAE02πDATA &H00AA,&H0000,&H0000,&H00F8,&HAE02,&H00AA,&H0000,&H0000πDATA &H00F8,&HAE02,&H00AA,&H0000,&H0000,&H00A4,&H51BD,&HF855πDATA &H0000,&H0A00,&H00F0,&H5500,&H0000,&H0000,&H0000,&H00F0πDATA &H5500,&H0000,&H0000,&H0000,&H00F0,&H5500,&H0000,&H0000πDATA &H0000,&H004C,&HAA1F,&H04FD,&H0000,&H0500,&H00F8,&HAA00πDATA &H0000,&H0000,&H0000,&H00F8,&HAA00,&H0000,&H0000,&H0000πDATA &H00F8,&HAA00,&H0000,&H0000,&H0000,&H00AE,&H550F,&H2280πDATA &H0000,&H0A00,&H00FC,&H1000,&H0000,&H0000,&H0000,&H00FCπDATA &H1000,&H0000,&H0000,&H0000,&H00FC,&H1000,&H0000,&H0000πDATA &H0000,&H0110,&HEF01,&H0001,&H0000,&H0100,&H00FE,&HA800πDATA &H8000,&H0000,&H0000,&H00FE,&HA800,&H8000,&H0000,&H0000πDATA &H00FE,&HA800,&H8000,&H0000,&H0000,&H0BE8,&H57EB,&H7EFFπDATA &H8080,&H0A00,&H00FC,&H1400,&H4000,&H0000,&H0000,&H00FCπDATA &H1400,&H4000,&H0000,&H0000,&H00FC,&H1400,&H4000,&H0000πDATA &H0000,&H0543,&HEBD5,&HBDFF,&H0000,&H0000,&H00FE,&H2A00πDATA &HA002,&H0000,&H0000,&H00FE,&H2A00,&HA002,&H0000,&H0000πDATA &H00FE,&H2A00,&HA002,&H0000,&H0000,&H0AAB,&HD5AB,&H5FFDπDATA &H80AF,&H020A,&H00FF,&H1500,&H1000,&H0000,&H0000,&H00FFπDATA &H1500,&H1000,&H0000,&H0000,&H00FF,&H1500,&H1000,&H0000πDATA &H0000,&H0054,&H6A01,&H6FF1,&H00FF,&H010F,&H80FF,&H3E08πDATA &H0A80,&H00A8,&H0008,&H80FF,&H3E08,&H0A80,&H00A8,&H0008πDATA &H80FF,&H3E08,&H0A80,&H00A8,&H0008,&H08FE,&HC126,&H3569πDATA &H8057,&H0A07,&H80FF,&H1400,&H0000,&H0040,&H0004,&H80FFπDATA &H1400,&H0000,&H0040,&H0004,&H80FF,&H1400,&H0000,&H0040πDATA &H0004,&H0055,&H6B1C,&H47D8,&H00BF,&H005B,&H80FF,&H3A00πDATA &H0280,&H00A0,&H003A,&H80FF,&H3A00,&H0280,&H00A0,&H003AπDATA &H80FF,&H3A00,&H0280,&H00A0,&H003A,&H0ABF,&HC5BA,&H6D7AπDATA &H835F,&H02C5,&H00FF,&H1400,&H0000,&H0000,&H007C,&H00FFπDATA &H1400,&H0000,&H0000,&H007C,&H00FF,&H1400,&H0000,&H0000πDATA &H007C,&H8555,&H6B74,&HFFF5,&H01FF,&H0003,&H00FF,&H2A00πDATA &HEAA0,&H00A8,&H00BE,&H00FF,&H2A00,&HEAA0,&H00A8,&H00BEπDATA &H00FF,&H2A00,&HEAA0,&H00A8,&H00BE,&H8BFE,&HD5FA,&H155FπDATA &H8357,&H0041,&H00FF,&H1400,&H5440,&H0040,&H0054,&H00FFπDATA &H1400,&H5440,&H0040,&H0054,&H00FF,&H1400,&H5440,&H0040πDATA &H0054,&H05D4,&HEBD4,&HABBF,&H45BF,&H00AB,&H00FE,&H2A00πDATA &HBAAA,&H00A0,&H00EA,&H00FE,&H2A00,&HBAAA,&H00A0,&H00EAπDATA &H00FE,&H2A00,&HBAAA,&H00A0,&H00EA,&H2BFE,&HD5FA,&H4555πDATA &HA35F,&H0014,&H00FE,&H1100,&H5555,&H0000,&H0074,&H00FEπDATA &H1100,&H5555,&H0000,&H0074,&H00FE,&H1100,&H5555,&H0000πDATA &H0074,&H0754,&HEEF1,&HAAAA,&H07FF,&H008A,&H00FE,&HAF80πDATA &HFEFE,&H02A8,&H00E8,&H00FE,&HAF80,&HFEFE,&H02A8,&H00E8πDATA &H00FE,&HAF80,&HFEFE,&H02A8,&H00E8,&H2FFF,&H507B,&H0101πDATA &HAD57,&H0016,&H00FF,&H5500,&HDD5D,&H0140,&H00D4,&H00FFπDATA &H5500,&HDD5D,&H0140,&H00D4,&H00FF,&H5500,&HDD5D,&H0140πDATA &H00D4,&H1F54,&HAAF5,&H22A2,&H46BF,&H0028,&H82FF,&HABA0πDATA &HFFFF,&H00A0,&H00A8,&H82FF,&HABA0,&HFFFF,&H00A0,&H00A8πDATA &H82FF,&HABA0,&HFFFF,&H00A0,&H00A8,&H2DB8,&H545B,&H0000πDATA &HAF5F,&H0056,&H81FD,&H5101,&HF57F,&H0000,&H0000,&H81FDπDATA &H5101,&HF57F,&H0000,&H0000,&H81FD,&H5101,&HF57F,&H0000πDATA &H0000,&H5E53,&HAEF6,&H0A80,&H55FF,&H00FC,&HCAFF,&HEAE2πDATA &HFEFB,&H00A0,&H00E0,&HCAFF,&HEAE2,&HFEFB,&H00A0,&H00E0πDATA &HCAFF,&HEAE2,&HFEFB,&H00A0,&H00E0,&HB5E8,&H151D,&H0104πDATA &HEF5F,&H0018,&HC5FD,&HD441,&HFD5F,&H0540,&H0040,&HC5FDπDATA &HD441,&HFD5F,&H0540,&H0040,&HC5FD,&HD441,&HFD5F,&H0540πDATA &H0040,&H1A52,&H2BB6,&H02A0,&H52BD,&H00B0,&H83FF,&HFE83πDATA &HFA3F,&H03A0,&H00A0,&H83FF,&HFE83,&HFA3F,&H03A0,&H00A0πDATA &H83FF,&HFE83,&HFA3F,&H03A0,&H00A0,&HBCA8,&H017C,&H05C0πDATA &HAC5F,&H0250,&H01FD,&H5F01,&HF556,&H0500,&H0040,&H01FDπDATA &H5F01,&HF556,&H0500,&H0040,&H01FD,&H5F01,&HF556,&H0500πDATA &H0040,&H9E52,&HA0D6,&H0AA9,&H52FF,&H00A0,&H02FF,&HEF80πDATA &HFEFF,&H03A0,&H0080,&H02FF,&HEF80,&HFEFF,&H03A0,&H0080πDATA &H02FF,&HEF80,&HFEFF,&H03A0,&H0080,&HADA8,&H107F,&H0100πDATA &HAC5F,&H0A60,&H04FD,&H1C00,&HFD75,&H0040,&H0000,&H04FDπDATA &H1C00,&HFD75,&H0040,&H0000,&H04FD,&H1C00,&HFD75,&H0040πDATA &H0000,&H1B52,&HE3D5,&H028A,&H47BD,&H0080,&H02FE,&H3F00πDATA &HFFFB,&H00A0,&H0000,&H02FE,&H3F00,&HFFFB,&H00A0,&H0000πDATA &H02FE,&H3F00,&HFFFB,&H00A0,&H0000,&H0DA9,&HC0BF,&H0004πDATA &HAE5F,&H0000,&H00FC,&H1700,&H7555,&H0000,&H0000,&H00FCπDATA &H1700,&H7555,&H0000,&H0000,&H00FC,&H1700,&H7555,&H0000πDATA &H0000,&H0753,&HE817,&H8AAA,&H04FF,&H0000,&H00FE,&HAF00πDATA &HFEEF,&H00E8,&H0000,&H00FE,&HAF00,&HFEEF,&H00E8,&H0000πDATA &H00FE,&HAF00,&HFEEF,&H00E8,&H0000,&H0FE8,&H50AF,&H0110πDATA &H8C16,&H0000,&H00FC,&H5500,&H5554,&H0040,&H0000,&H00FCπDATA &H5500,&H5554,&H0040,&H0000,&H00FC,&H5500,&H5554,&H0040πDATA &H0000,&H0752,&HAA05,&HAAAB,&H04BD,&H0000,&H00FA,&HAA00πDATA &HFBAA,&H00A0,&H0000,&H00FA,&HAA00,&HFBAA,&H00A0,&H0000πDATA &H00FA,&HAA00,&HFBAA,&H00A0,&H0000,&H0FAC,&H558B,&H0455πDATA &HA85E,&H2200,&H00FC,&H1500,&H7140,&H0050,&H0000,&H00FCπDATA &H1500,&H7140,&H0050,&H0000,&H00FC,&H1500,&H7140,&H0050πDATA &H0000,&H0752,&HEA41,&H8EB5,&H10AD,&H0000,&H00FE,&H2A00πDATA &HFF00,&H00E8,&H0000,&H00FE,&H2A00,&HFF00,&H00E8,&H0000πDATA &H00FE,&H2A00,&HFF00,&H00E8,&H0000,&H0FE8,&HD5EB,&H00FFπDATA &HA816,&HBF00,&H00FC,&H0400,&H5500,&H0040,&H0700,&H00FCπDATA &H0400,&H5500,&H0040,&H0700,&H00FC,&H0400,&H5500,&H0040πDATA &H0700,&H0752,&HFBD7,&HAAFD,&H10BC,&H7800,&H00FA,&HBF02πDATA &HFFA8,&H00A0,&H2F00,&H00FA,&HBF02,&HFFA8,&H00A0,&H2F00πDATA &H00FA,&HBF02,&HFFA8,&H00A0,&H2F00,&H03A4,&H40AD,&H0057πDATA &H385A,&HD200,&H00F8,&H7F01,&H5555,&H0000,&H1700,&H00F8πDATA &H7F01,&H5555,&H0000,&H1700,&H00F8,&H7F01,&H5555,&H0000πDATA &H1700,&H0156,&H8016,&HAAAA,&H50F4,&H6800,&H00FA,&HFF00πDATA &HFEEE,&H00A0,&H0F00,&H00FA,&HFF00,&HFEEE,&H00A0,&H0F00πDATA &H00FA,&HFF00,&HFEEE,&H00A0,&H0F00,&H00E4,&H00AF,&H0111πDATA &HE05A,&HF000,&H00FE,&H5500,&HDD55,&H0000,&H1700,&H00FEπDATA &H5500,&HDD55,&H0000,&H1700,&H00FE,&H5500,&HDD55,&H0000πDATA &H1700,&H0041,&HAA57,&H22AA,&HD0F5,&H6800,&H00FA,&H2B00πDATA &HFAFF,&H0080,&H0F00,&H00FA,&H2B00,&HFAFF,&H0080,&H0F00πDATA &H00FA,&H2B00,&HFAFF,&H0080,&H0F00,&H00A5,&HD4AF,&H0500πDATA &HE07B,&HF200,&H00F6,&H1500,&H5457,&H0000,&H1700,&H00F6πDATA &H1500,&H5457,&H0000,&H1700,&H00F6,&H1500,&H5457,&H0000πDATA &H1700,&H0049,&HEA17,&HABA8,&HD0D7,&H6800,&H00FE,&HAF00πDATA &HEAFF,&H800A,&H0F00,&H00FE,&HAF00,&HEAFF,&H800A,&H0F00πDATA &H00FE,&HAF00,&HEAFF,&H800A,&H0F00,&H80E1,&H50AF,&H1500πDATA &H68E5,&HF200,&H00FE,&H5D00,&H545D,&H0004,&H0700,&H00FEπDATA &H5D00,&H545D,&H0004,&H0700,&H00FE,&H5D00,&H545D,&H0004πDATA &H0700,&H0041,&HA217,&HABA2,&HC4DB,&H7800,&H00FF,&HBF00πDATA &HA8FA,&H002A,&H0F00,&H00FF,&HBF00,&HA8FA,&H002A,&H0F00πDATA &H00FF,&HBF00,&HA8FA,&H002A,&H0F00,&H00A2,&H402F,&H5705πDATA &HEED5,&HB200,&H00F7,&H5700,&H0055,&H0415,&H1700,&H00F7πDATA &H5700,&H0055,&H0415,&H1700,&H00F7,&H5700,&H0055,&H0415πDATA &H1700,&H0048,&HA815,&HFDAA,&HDAEA,&H6800,&H00FF,&HBF00πDATA &H80FE,&H9EFE,&H0F00,&H00FF,&HBF00,&H80FE,&H9EFE,&H0F00πDATA &H00FF,&HBF00,&H80FE,&H9EFE,&H0F00,&H80E0,&H400F,&H7F01πDATA &H6801,&HF000,&H00F7,&H5500,&H01D4,&H7CFC,&H0700,&H00F7πDATA &H5500,&H01D4,&H7CFC,&H0700,&H00F7,&H5500,&H01D4,&H7CFCπDATA &H0700,&H0048,&HAA05,&HDE2B,&H9303,&H7800,&H00FF,&H2B00πDATA &H03F8,&HFEFA,&H0F00,&H00FF,&H2B00,&H03F8,&HFEFA,&H0F00πDATA &H00FF,&H2B00,&H03F8,&HFEFA,&H0F00,&H80A2,&HD403,&HFC07πDATA &H2905,&H3000,&H00F7,&H0100,&H1740,&HFDF7,&H0700,&H00F7πDATA &H0100,&H1740,&HFDF7,&H0700,&H00F7,&H0100,&H1740,&HFDF7πDATA &H0700,&H0048,&H7E01,&H68BD,&H5209,&H1800,&H80FF,&H0200πDATA &HBF80,&HFFFF,&H0F00,&H80FF,&H0200,&HBF80,&HFFFF,&H0F00πDATA &H80FF,&H0200,&HBF80,&HFFFF,&H0F00,&H00EA,&HFD00,&H406FπDATA &HE80F,&H3080,&H00FF,&H0000,&H5F01,&HFFFF,&H0700,&H00FFπDATA &H0000,&H5F01,&HFFFF,&H0700,&H00FF,&H0000,&H5F01,&HFFFFπDATA &H0700,&H8040,&H0000,&HA05E,&HD40F,&H5880,&H80FF,&H0000πDATA &HFF2B,&HFFFF,&H0F80,&H80FF,&H0000,&HFF2B,&HFFFF,&H0F80πDATA &H80FF,&H0000,&HFF2B,&HFFFF,&H0F80,&H00A2,&HA203,&H00D4πDATA &HFA3F,&H3240,&H80FF,&H0001,&H7F15,&HFFFF,&H0700,&H80FFπDATA &H0001,&H7F15,&HFFFF,&H0700,&H80FF,&H0001,&H7F15,&HFFFFπDATA &H0700,&H0040,&H5102,&H806A,&H547F,&H18C0,&H80FF,&H0002πDATA &HFFAF,&HFFFF,&H0FC0,&H80FF,&H0002,&HFFAF,&HFFFF,&H0FC0πDATA &H80FF,&H0002,&HFFAF,&HFFFF,&H0FC0,&H80CA,&HFB01,&H0350πDATA &HFEFF,&H32A0,&H80FF,&H0001,&HFF55,&HFFFF,&H07C0,&H80FFπDATA &H0001,&HFF55,&HFFFF,&H07C0,&H80FF,&H0001,&HFF55,&HFFFFπDATA &H07C0,&H4040,&H7D02,&H05AA,&HD4FD,&H1800,&H80FF,&H8001πDATA &HFFBF,&HFFFF,&H02C0,&H80FF,&H8001,&HFFBF,&HFFFF,&H02C0πDATA &H80FF,&H8001,&HFFBF,&HFFFF,&H02C0,&H4082,&H3F02,&H3F40πDATA &HFAFF,&H3DA0,&H80DF,&H0001,&HFF57,&HFFFF,&H00C0,&H80DFπDATA &H0001,&HFF57,&HFFFF,&H00C0,&H80DF,&H0001,&HFF57,&HFFFFπDATA &H00C0,&H4020,&HFF02,&H3FA8,&HF5F7,&H1000,&HC0FF,&HC800πDATA &HFFAF,&HFFFF,&H00E0,&HC0FF,&HC800,&HFFAF,&HFFFF,&H00E0πDATA &HC0FF,&HC800,&HFFAF,&HFFFF,&H00E0,&H808A,&H3703,&HFF50πDATA &HFEFF,&H0A98πDATA &H0040,&H0009,&HFFC0,&HFFFF,&H3FFC,&HFFFF,&H0000,&H0000πDATA &H0000,&H0000,&H003F,&H0000,&HC003,&H0000,&H0000,&H0000πDATA &H0000,&H0000,&HFF80,&HFFFF,&H1FF8,&HFFFF,&H0000,&H0000πDATA &H0000,&H0000,&H007F,&H0000,&HE007,&H0000,&H0000,&H0000πDATA &H0000,&H0000,&HC13F,&H7000,&HC9F3,&H7098,&H0000,&H0000πDATA &H0000,&H0000,&H3EC0,&H8FFF,&H360C,&H8F67,&H0000,&H0000πDATA &H0000,&H0000,&H813F,&H2000,&HC973,&H2090,&H0000,&H0000πDATA &H0000,&H0000,&H7EC0,&HDFFF,&H368C,&HDF6F,&H0000,&H0000πDATA &H0000,&H0000,&H9930,&H2633,&HC973,&H2793,&H0000,&H0000πDATA &H0000,&H0000,&H66CF,&HD9CC,&H368C,&HD86C,&H0000,&H0000πDATA &H0000,&H0000,&H9930,&H2433,&HC973,&H2792,&H0000,&H0000πDATA &H0000,&H0000,&H66CF,&HDBCC,&H368C,&HD86D,&H0000,&H0000πDATA &H0000,&H0000,&H993C,&H2733,&HC9F3,&HE713,&H0000,&H0000πDATA &H0000,&H0000,&H66C3,&HD8CC,&H360C,&H18EC,&H0000,&H0000πDATA &H0000,&H0000,&H8980,&H2033,&H18F8,&H6730,&H0000,&H0000πDATA &H0000,&H0000,&H767F,&HDFCC,&HE707,&H98CF,&H0000,&H0000πDATA &H0000,&H0000,&HC9C1,&H3033,&H3CFC,&H6778,&H0000,&H0000πDATA &H0000,&H0000,&H363E,&HCFCC,&HC303,&H9887,&H0000,&H0000πDATA &H0000,&H0000πDATA "Hello everyone!"πDATA ""πDATA "Everyone thought I was stingy for not"πDATA "letting anyone see my source code, so"πDATA "I finnaly did it.  Even though I made"πDATA "this little game in Qb 4.5, I left it"πDATA "uncompiled for your enjoyment."πDATA ""πDATA "The only reason I'm letting you guys"πDATA "see this one is becuase I learned much"πDATA "by looking at everyone else's code so"πDATA "I thought it only fair."πDATA ""πDATA "The program structure is really crappy"πDATA "on this I know.  There are tons of"πDATA "optimizations you could probably do,"πDATA "but why even try?"πDATA ""πDATA "This game is pretty cool, considering"πDATA "the time it took to make it."πDATA "I did this in a week starting May 19."πDATA "I decided I was too cool for the"πDATA "freshman class trip so I got stuck here"πDATA "sitting in front of the computer."πDATA "So, I erased C++, re-installed Qb 4.5"πDATA "and I went to work on a game where"πDATA "shrapnel flies left and right."πDATA ""πDATA "Balloon X is the sequel to"πDATA "Balloon X.O.G, which had Adlib sound."πDATA "Why did I change it?  Well, the"πDATA "original (O.G.) was made with all the"πDATA "things you could only do with Qb 4.5."πDATA "I decided to make one for the Qbasic"πDATA "kids.  HE HE!"πDATA ""πDATA "Sorry it's so big."πDATA ""πDATA "If any of you guys want to make a"πDATA "game with me in Basic, C, or Pas,"πDATA "let me know."πDATA "I'm getting really bored."πDATA ""πDATA "Manny Najera"πDATA "Collect 2 Gems"πDATA "Collect 4 Gems"πDATA "Collect 6 Gems"πDATA "Collect 8 Gems"πDATA "Collect 10 Gems"πDATA &H0005,&H0008,&H1010,&H1010,&H2828,&H2828,&H2020,&H2020πDATA &H0000,&H7100,&H1010,&HEB10,&H0000,&HFB00,&H0000,&HFB00πDATA &H0000,&H7100πDATA &H0005,&H0008,&HEBEB,&HEBEB,&HD3D3,&HD3D3,&HDBDB,&HDBDBπDATA &H8A8A,&H8A8A,&H0000,&H0000,&H0000,&H0000,&H0000,&H0000πDATA &H8A8A,&H8A8AπDATA &H0005,&H0008,&H1010,&H1010,&H2020,&H2020,&H2020,&H2020πDATA &H0000,&H7100,&H1010,&HEB10,&H0000,&HFB00,&H0000,&HFB00πDATA &H0000,&H7100πDATA &H0005,&H0008,&HEBEB,&HEBEB,&HDBDB,&HDBDB,&HDBDB,&HDBDBπDATA &H8A8A,&H8A8A,&H0000,&H0000,&H0000,&H0000,&H0000,&H0000πDATA &H8A8A,&H8A8AπDATA &H0005,&H0008,&H0000,&H0000,&H2020,&H2020,&H2020,&H2020πDATA &H0000,&H7100,&H1010,&HEB10,&H0000,&HFB00,&H0000,&HFB00πDATA &H0000,&H7100πDATA &H0005,&H0008,&HFBFB,&HFBFB,&HDBDB,&HDBDB,&HDBDB,&HDBDBπDATA &H8A8A,&H8A8A,&H0000,&H0000,&H0000,&H0000,&H0000,&H0000πDATA &H8A8A,&H8A8AπDATA &H0005,&H0008,&H0000,&H0000,&H0000,&H0000,&H2020,&H2020πDATA &H0000,&H7000,&H1010,&HE810,&H0000,&HF800,&H0000,&HF800πDATA &H0000,&H7000πDATA &H0005,&H0008,&HF8F8,&HF8F8,&HF8F8,&HF8F8,&HD8D8,&HD8D8πDATA &H8888,&H8888,&H0000,&H0000,&H0000,&H0000,&H0000,&H0000πDATA &H8888,&H8888πDATA &H0042,&H0009,&HFF3F,&HFCFF,&H13F8,&HFFFF,&H00FF,&H0000πDATA &H0000,&H0000,&H0000,&H00C0,&H0300,&HEC07,&H0000,&H0000πDATA &H0000,&H0000,&H0000,&H0000,&HFF3F,&HFCFF,&H13F0,&HFFFFπDATA &H00FF,&H0000,&H0000,&H0000,&H0000,&H00C0,&H0300,&HEC0FπDATA &H0000,&H0000,&H0000,&H0000,&H0000,&H0000,&HC33F,&H0C33πDATA &HF3E7,&H0C0E,&H003F,&H0000,&H0000,&H0000,&H0000,&H3CC0πDATA &HF3CC,&H0C18,&HF3F1,&H00C0,&H0000,&H0000,&H0000,&H0000πDATA &H813F,&H0432,&HF2E7,&H0804,&H003F,&H0000,&H0000,&H0000πDATA &H0000,&H7EC0,&HFBCD,&H0D18,&HF7FB,&H00C0,&H0000,&H0000πDATA &H0000,&H0000,&H993F,&H6432,&HF2E7,&HC964,&H00FF,&H0000πDATA &H0000,&H0000,&H0000,&H66C0,&H9BCD,&H0D18,&H369B,&H0000πDATA &H0000,&H0000,&H0000,&H0000,&H913F,&H4432,&HF2E7,&HC944πDATA &H00FF,&H0000,&H0000,&H0000,&H0000,&H6EC0,&HBBCD,&H0D18πDATA &H36BB,&H0000,&H0000,&H0000,&H0000,&H0000,&H9F3F,&H7C22πDATA &HF2E7,&HC97C,&H00FF,&H0000,&H0000,&H0000,&H0000,&H60C0πDATA &H83DD,&H0D18,&H3683,&H0000,&H0000,&H0000,&H0000,&H0000πDATA &H8380,&H0C06,&H12F0,&H490C,&H00FF,&H0000,&H0000,&H0000πDATA &H0000,&H7C7F,&HF3F9,&HED0F,&HB6F3,&H0000,&H0000,&H0000πDATA &H0000,&H0000,&HC3C0,&H0C8F,&H13F8,&H490E,&H00FF,&H0000πDATA &H0000,&H0000,&H0000,&H3C3F,&HF370,&HEC07,&HB6F1,&H0000πDATA &H0000,&H0000,&H0000,&H0000ππREM $STATICπFUNCTION BoxHit% (Hx1, Hy1, hx2, hy2)ππBhx = Bal.X + 7πBhy = Bal.Y + 7ππIF Bal.X > Hx1 AND Bhx < hx2 AND Bhy > Hy1 AND Bal.Y < hy2 THENπBoxHit% = 1πGOTO EBoxπEND IFππBoxHit% = 0πEBox:πEND FUNCTIONππSUB Center (Row, Text$, C)πCOLOR CπLOCATE Row, 21 - (LEN(Text$) / 2)πPRINT Text$πCOLOR 15πEND SUBππSUB CreateTableπFOR I = 1 TO 360πXSin(I) = SIN(I)πXcos(I) = COS(I)πNEXTπEND SUBππSUB DeadDuckπFOR T = 1 TO 84 STEP 4πSCREEN 7, 0, 2, 0: PCOPY 1, 2πLINE (0, 0)-(T, 200), 1, BFπLINE (80, 0)-(80 + T, 200), 1, BFπLINE (160, 0)-(160 + T, 200), 1, BFπLINE (240, 0)-(240 + T, 200), 1, BFπSCREEN 7, 0, 0, 0: PCOPY 2, 0: PCOPY 1, 2πNEXTπCOLOR 15, 1πSCREEN 7, 0, 2, 0πCLSπLINE (0, 0)-(319, 199), 1, BFπPUT (160 - 32, 100), Gop, PSETπPCOPY 2, 0πA$ = INPUT$(1)πSCREEN 7, 0, 0, 2πCOLOR 15, 0πMakeTitleScreenπDoMenuπEND SUBππSUB DoBItemππFOR I = 1 TO 5ππIF BItem(I).Active = 0 THENπBItem(I).Clock = BItem(I).Clock + 1πEND IFπππIF BItem(I).Clock = 50 THENπBItem(I).X = Fnr(290) + 10πBItem(I).Y = 11πBItem(I).Ym = Fnr(3) + 3πBItem(I).Active = 1πBItem(I).num = Fnr(2)πBItem(I).Clock = Fnr(30)πEND IFππIF BItem(I).Active = 1 THENπBItem(I).Y = BItem(I).Y + BItem(I).YmπEND IFππIF BItem(I).Y > 180 THENπBItem(I).Active = 0πBItem(I).Y = 300πEND IFππIF BItem(I).Active = 1 THENπSELECT CASE BItem(I).numπCASE 1πPUT (BItem(I).X, BItem(I).Y), P1, PSETπCASE 2πPUT (BItem(I).X, BItem(I).Y), P5, PSETπEND SELECTπIF BoxHit%(BItem(I).X - 5, BItem(I).Y - 5, BItem(I).X + 15, BItem(I).Y + 10) = 1 THENπBItem(I).Active = 0πSELECT CASE BItem(I).numπCASE 1πCurrent.Score = Current.Score + 100πCASE 2πCurrent.Score = Current.Score + 500πEND SELECTπEND IFπEND IFππNEXTππEND SUBππSUB DoBomb (lev)ππFOR I = 1 TO levππBomb(I).Clock = Bomb(I).Clock + 1ππIF Bomb(I).Anclock < 21 THEN Bomb(I).AnFlag = 1πIF Bomb(I).Anclock > 20 AND Bomb(I).Anclock < 41 THEN Bomb(I).AnFlag = 2πIF Bomb(I).Anclock > 40 AND Bomb(I).Anclock < 61 THEN Bomb(I).AnFlag = 3πIF Bomb(I).Anclock > 60 AND Bomb(I).Anclock < 81 THEN Bomb(I).AnFlag = 4ππππIF Bomb(I).Active = 0 THENπBomb(I).Anclock = Bomb(I).Anclock + 1πSELECT CASE Bomb(I).AnFlagπCASE 1πPUT (Bomb(I).Sx, Bomb(I).Sy), Bomb1m, ANDπPUT (Bomb(I).Sx, Bomb(I).Sy), Bomb1, XORπCASE 2πPUT (Bomb(I).Sx, Bomb(I).Sy), Bomb2m, ANDπPUT (Bomb(I).Sx, Bomb(I).Sy), Bomb2, XORπCASE 3πPUT (Bomb(I).Sx, Bomb(I).Sy), Bomb3m, ANDπPUT (Bomb(I).Sx, Bomb(I).Sy), Bomb3, XORπCASE 4πPUT (Bomb(I).Sx, Bomb(I).Sy), Bomb4m, ANDπPUT (Bomb(I).Sx, Bomb(I).Sy), Bomb4, XORπEND SELECTπEND IFππIF Bomb(I).Rclock = 200 THENπBomb(I).Anclock = 0πBomb(I).AnFlag = 1πBomb(I).Active = 0πBomb(I).Rclock = 0πBomb(I).Clock = 0πBomb(I).Sx = Fnr(300) + 10πBomb(I).Sy = Fnr(180) + 11πEND IFππIF Bomb(I).Clock = 80 THENπBomb(I).Active = 1πEND IFππIF Bomb(I).Active = 1 THENπBomb(I).Rclock = Bomb(I).Rclock + 4πFOR T = 1 TO 40 STEP 2πBomb(I).Fx = Bomb(I).Sx + Xcos(T) * Bomb(I).RclockπBomb(I).Fy = Bomb(I).Sy + XSin(T) * Bomb(I).RclockπIF Bomb(I).Fx < 0 OR Bomb(I).Fx > 320 OR Bomb(I).Fy < 11 OR Bomb(I).Fy > 198 THEN GOTO ClipπPSET (Bomb(I).Fx, Bomb(I).Fy), 14πIF PointHit%(Bomb(I).Fx, Bomb(I).Fy) = 1 THENπBal.Dead = 1πBal.Dx = Bal.XπBal.Dy = Bal.YπEND IFπClip:πNEXTπEND IFππNEXTππEND SUBππSUB DoCheapEndingπSCREEN 7, 0, 7, 0πMakeStars 300πScsc$ = "Final Score:" + STR$(Current.Score)πCenter 2, "YOU WON?", 15πCenter 4, "To tell you the truth...", 3πCenter 6, "I can't even get past level 2.", 5πCenter 10, "Look man...", 8πCenter 12, "This game has no plot,", 2πCenter 14, "Therefore it can have no ending.", 2πCenter 17, "Just remember,", 9πCenter 20, "The spirit of Balloon X is in YOU!", 15πCenter 23, Scsc$, 14πFOR T = 1 TO 120 STEP 4πSCREEN 7, 0, 2, 0: PCOPY 1, 2πLINE (0, 0)-(320, T), 1, BFπLINE (0, 200)-(320, 200 - T), 1, BFπSCREEN 7, 0, 0, 0: PCOPY 2, 0: PCOPY 1, 2πNEXTπPCOPY 7, 1πFOR T = 120 TO -4 STEP -4πSCREEN 7, 0, 2, 0: PCOPY 1, 2πLINE (0, 0)-(320, T), 1, BFπLINE (0, 200)-(320, 200 - T), 1, BFπSCREEN 7, 0, 0, 0: PCOPY 2, 0: PCOPY 1, 2πNEXTπDOπSCREEN 7, 0, 2, 0: PCOPY 1, 2πSCREEN 7, 0, 0, 0: PCOPY 2, 0: PCOPY 1, 2πLOOP UNTIL INKEY$ <> ""πFOR T = 1 TO 120 STEP 4πSCREEN 7, 0, 2, 0: PCOPY 1, 2πLINE (0, 0)-(320, T), 1, BFπLINE (0, 200)-(320, 200 - T), 1, BFπSCREEN 7, 0, 0, 0: PCOPY 2, 0: PCOPY 1, 2πNEXTπMakeTitleScreenπDoMenuπEND SUBππSUB DoDemoModeππFOR T = 1 TO 120 STEP 4πSCREEN 7, 0, 2, 0: PCOPY 1, 2πLINE (0, 0)-(320, T), 1, BFπLINE (0, 200)-(320, 200 - T), 1, BFπSCREEN 7, 0, 0, 0: PCOPY 2, 0: PCOPY 1, 2πNEXTππPCOPY 3, 1πSCREEN 7, 0, 1, 1ππFOR T = 120 TO 0 STEP -4πSCREEN 7, 0, 2, 0: PCOPY 1, 2πLINE (0, 0)-(320, T), 1, BFπLINE (0, 200)-(320, 200 - T), 1, BFπSCREEN 7, 0, 0, 0: PCOPY 2, 0: PCOPY 1, 2πNEXTππDl = 0ππDOπSCREEN 7, 0, 2, 0: PCOPY 1, 2πDl = Dl + 1πIF Dl = 600 THENπDl = 0πEXIT DOπEND IFπCenter 13, "Demo Mode", 15πDoTorpedo 3πDoMissle 3πDoBomb 2πDoItemπSCREEN 7, 0, 0, 0: PCOPY 2, 0: PCOPY 1, 2πLOOP UNTIL INKEY$ <> ""πFOR T = 1 TO 84 STEP 4πSCREEN 7, 0, 2, 0: PCOPY 1, 2πLINE (0, 0)-(T, 200), 1, BFπLINE (80, 0)-(80 + T, 200), 1, BFπLINE (160, 0)-(160 + T, 200), 1, BFπLINE (240, 0)-(240 + T, 200), 1, BFπSCREEN 7, 0, 0, 0: PCOPY 2, 0: PCOPY 1, 2πNEXTπMakeTitleScreenπDoMenuπEND SUBππSUB DoExitπFOR T = 1 TO 120 STEP 4πSCREEN 7, 0, 2, 0: PCOPY 1, 2πLINE (0, 0)-(320, T), 1, BFπLINE (0, 200)-(320, 200 - T), 1, BFπSCREEN 7, 0, 0, 0: PCOPY 2, 0: PCOPY 1, 2πNEXTπSCREEN 7, 0, 1, 0πCLSπMakeStars 300πCenter 5, "- Programming -", 15πCenter 8, "Manny Najera", 4πCenter 11, "- Graphics -", 15πCenter 14, "Manny Najera", 9πCenter 17, "- Game Design -", 15πCenter 20, "Manny Najera", 12πFOR T = 120 TO 0 STEP -4πSCREEN 7, 0, 2, 0: PCOPY 1, 2πLINE (0, 0)-(320, T), 1, BFπLINE (0, 200)-(320, 200 - T), 1, BFπSCREEN 7, 0, 0, 0: PCOPY 2, 0: PCOPY 1, 2πNEXTπDOπSCREEN 7, 0, 2, 0: PCOPY 1, 2πSCREEN 7, 0, 0, 0: PCOPY 2, 0: PCOPY 1, 2πLOOP UNTIL INKEY$ <> ""πENDπEND SUBππSUB DoIntroπA$ = INPUT$(1)πLINE (ManX, ManY)-(ManX + 54, ManY + 27), 0, BFπFOR T = 1 TO 200 STEP 5πSCREEN 7, 0, 2, 0: PCOPY 1, 2πFOR N = 1 TO 40 STEP 2πPSET (ManX + 20 + XSin(N) * T, ManY + 13 + Xcos(N) * T), 9πPSET (ManX + 20 + XSin(N) * 2 * T, ManY + 13 + Xcos(N) * N), 12πPSET (ManX + 20 + XSin(N) * N, ManY + 13 + Xcos(N) * 2 * T), 1πNEXTπSCREEN 7, 0, 0, 0: PCOPY 2, 0: PCOPY 1, 2πNEXTππFOR T = 1 TO 84 STEP 4πSCREEN 7, 0, 2, 0: PCOPY 1, 2πLINE (0, 0)-(T, 200), 1, BFπLINE (80, 0)-(80 + T, 200), 1, BFπLINE (160, 0)-(160 + T, 200), 1, BFπLINE (240, 0)-(240 + T, 200), 1, BFπSCREEN 7, 0, 0, 0: PCOPY 2, 0: PCOPY 1, 2πNEXTπEND SUBππSUB DoItemπππIF Item.Active = 0 THENπItem.ActCount = Item.ActCount + 1πItem.X = 500πEND IFππIF Item.ActCount = 200 THENπItem.Active = 1πItem.X = Fnr(290) + 10πItem.Y = Fnr(170) + 11πItem.num = Fnr(4)πItem.EndCount = 0πItem.ActCount = 0πEND IFπ                 'w13 h7πIF BoxHit%(Item.X, Item.Y, Item.X + 15, Item.Y + 10) = 1 THENπItem.X = 400πSELECT CASE Item.numπCASE 1πCurrent.Score = Current.Score + 100πCASE 2πCurrent.Score = Current.Score + 500πCASE 3πCurrent.Gems = Current.Gems + 1πCASE 4πCurrent.Lives = Current.Lives + 1πEND SELECTπItem.EndCount = 100πItem.Active = 0πEND IFππIF Item.Active = 1 THENπItem.EndCount = Item.EndCount + 1πSELECT CASE Item.numπCASE 1πPUT (Item.X, Item.Y), P1, PSETπCASE 2πPUT (Item.X, Item.Y), P5, PSETπCASE 3πPUT (Item.X, Item.Y), Icon, PSETπCASE 4πPUT (Item.X, Item.Y), Coin1, PSETπEND SELECTππIF BoxHit%(Item.X, Item.Y, Item.X + 13, Item.Y + 7) = 1 THENπItem.X = 400πSELECT CASE Item.numπCASE 1πCurrent.Score = Current.Score + 100πCASE 2πCurrent.Score = Current.Score + 500πCASE 3πCurrent.Gems = Current.Gems + 1πCASE 4πCurremt.Lives = Current.Lives + 1πEND SELECTπItem.EndCount = 100πItem.X = 500πItem.Active = 0πEND IFπEND IFππIF Item.EndCount = 100 THEN Item.Active = 0πEND SUBππSUB DoMenuπMenu.Clock = 0πDOπSCREEN 7, 0, 2, 0: PCOPY 1, 2πMenu.Clock = Menu.Clock + 1πIF Menu.Clock = 400 THENπMenu.Clock = 0πDrawArenaπDoDemoModeπEND IFπChoice$ = UCASE$(INKEY$)πSELECT CASE Choice$πCASE CHR$(0) + CHR$(72)πMenu.num = Menu.num - 1πIF Menu.num < 1 THEN Menu.num = 1πCASE CHR$(0) + CHR$(80)πMenu.num = Menu.num + 1πIF Menu.num > 3 THEN Menu.num = 3πCASE CHR$(13)πGOTO ProChoiceπEND SELECTπSELECT CASE Menu.numπCASE 1πPUT (100, 111), Iconm, ANDπPUT (100, 111), Icon, XORπCASE 2πPUT (100, 143), Iconm, ANDπPUT (100, 143), Icon, XORπCASE 3πPUT (100, 175), Iconm, ANDπPUT (100, 175), Icon, XORπEND SELECTπSCREEN 7, 0, 0, 0: PCOPY 2, 0: PCOPY 1, 2πLOOPπProChoice:πSELECT CASE Menu.numπCASE 1πCurrent.Gems = 0πCurrent.Level = 1πCurrent.Score = 0πStartGameπCASE 2πSeeInfoπCASE 3πDoExitπEND SELECTπEND SUBππSUB DoMissle (lev)ππFOR I = 1 TO 3 + levππIF Missle(I).Active = 0 THENπMissle(I).ActCount = Missle(I).ActCount + 1πEND IFππIF Missle(I).ActCount = 100 AND Missle(I).Active = 0 THENπMissle(I).Active = 1πMissle(I).Y = Fnr(180) + 10πMissle(I).Xm = Fnr(6)πMissle(I).X = 3πEND IFππIF Missle(I).Active = 1 THENπMissle(I).X = Missle(I).X + Missle(I).XmπPUT (Missle(I).X, Missle(I).Y), Mrm, ANDπPUT (Missle(I).X, Missle(I).Y), Mr, XORπIF BoxHit%(Missle(I).X, Missle(I).Y, Missle(I).X + 10, Missle(I).Y + 10) = 1 THENπBal.Dead = 1πBal.Dx = Bal.XπBal.Dy = Bal.YπEND IFπIF Missle(I).X > 300 THENπMissle(I).Active = 0πMissle(I).ActCount = 0πEND IFπEND IFπNEXTπEND SUBππSUB DoTorpedo (lev)ππFOR I = 1 TO 2 + levππIF Tor(I).Active = 0 THENπTor(I).ActCount = Tor(I).ActCount + 1πEND IFππIF Tor(I).ActCount = 100 AND Tor(I).Active = 0 THENπTor(I).LoCount = Fnr(140) + 10πTor(I).Count = 0πTor(I).ActCount = 0πTor(I).Active = 1πTor(I).Ecount = 0πTor(I).X = Fnr(180) + 10πTor(I).Y = 185πTor(I).Ym = -1πTor(I).Ex = Fnr(130) + 50πEND IFππIF Tor(I).Active = 1 THENπTor(I).Count = Tor(I).Count + 1πTor(I).Y = Tor(I).Y + Tor(I).YmπIF Tor(I).Y < 11 THEN Tor(I).Active = 0πIF Tor(I).Exploding = 0 THENπPUT (Tor(I).X, Tor(I).Y), Torpm, ANDπPUT (Tor(I).X, Tor(I).Y), Torp, XORπEND IFπππIF Tor(I).Count = Tor(I).LoCount AND Tor(I).Exploding = 0 AND Tor(I).Ecount = 0 AND Tor(I).Active = 1 THENπTor(I).Exx = Tor(I).XπTor(I).Eyy = Tor(I).YπTor(I).Exploding = 1πEND IFππIF Tor(I).Exploding = 1 AND Tor(I).Active = 1 THENπTor(I).Ecount = Tor(I).Ecount + 5πFOR T = 1 TO 6πTor(I).Fx = Tor(I).Exx + XSin(T) * Tor(I).EcountπTor(I).Fy = Tor(I).Eyy + Xcos(T) * Tor(I).EcountπIF Tor(I).Fx < 0 OR Tor(I).Fx > 320 OR Tor(I).Fy < 11 OR Tor(I).Fy > 198 THEN GOTO TClipπPSET (Tor(I).Fx, Tor(I).Fy), 14πIF PointHit%(Tor(I).Fx, Tor(I).Fy) THENπBal.Dead = 1πBal.Dx = Bal.XπBal.Dy = Bal.YπEND IFπTClip:πNEXTπIF Tor(I).Ecount > 200 THENπTor(I).ActCount = 0πTor(I).Active = 0πTor(I).Exploding = 0πTor(I).Exx = -200πTor(I).Eyy = -200πEND IFπEND IFπEND IFππNEXTπEND SUBππSUB DrawArenaπSCREEN 7, 0, 3, 0πCLSπMakeStars 300πLINE (0, 0)-(319, 10), 0, BFπPUT (0, 0), Score, PSETπLINE (0, 11)-(319, 199), 15, BπLINE (1, 12)-(318, 198), 7, BπLINE (2, 13)-(317, 197), 8, BπLOCATE 1, 1: PRINT "Score:"πLOCATE 1, 14: PRINT "Lives:"πLOCATE 1, 27: PRINT "Gems:"πEND SUBππSUB DrawBalloonππIF Bal.Dead = 1 THENπBal.DeadClock = Bal.DeadClock + 5πIF Bal.DeadClock = 100 THENπBal.DeadClock = 0πCurrent.Lives = Current.Lives - 1πBal.Dead = 0πEND IFπIF Current.Lives = -1 THEN DeadDuckπFOR T = 1 TO 40 STEP 2πPSET (Bal.Dx + XSin(T) * Bal.DeadClock, Bal.Dy + Xcos(T) * Bal.DeadClock), 4πNEXTπIF Current.Lives = 0 THEN GOTO FinishdrawπEND IFπππIF Bal.Anclock = 80 THEN Bal.Anclock = 0πIF Bal.Anclock < 80 THEN Bal.Anclock = Bal.Anclock + 1πIF Bal.Anclock > 0 AND Bal.Anclock < 11 THENπBal.AnFlag = 1πPUT (Bal.X, Bal.Y), Bal1m, ANDπPUT (Bal.X, Bal.Y), Bal1, XORπGOTO FinishdrawπEND IFπIF Bal.Anclock > 10 AND Bal.Anclock < 21 THENπBal.AnFlag = 2πPUT (Bal.X, Bal.Y), Bal2m, ANDπPUT (Bal.X, Bal.Y), Bal2, XORπGOTO FinishdrawπEND IFπIF Bal.Anclock > 20 AND Bal.Anclock < 31 THENπBal.AnFlag = 3πPUT (Bal.X, Bal.Y), Bal3m, ANDπPUT (Bal.X, Bal.Y), Bal3, XORπGOTO FinishdrawπEND IFπIF Bal.Anclock > 30 AND Bal.Anclock < 41 THENπBal.AnFlag = 4πPUT (Bal.X, Bal.Y), Bal4m, ANDπPUT (Bal.X, Bal.Y), Bal4, XORπGOTO FinishdrawπEND IFπIF Bal.Anclock > 40 AND Bal.Anclock < 51 THENπBal.AnFlag = 5πPUT (Bal.X, Bal.Y), Bal5m, ANDπPUT (Bal.X, Bal.Y), Bal5, XORπGOTO FinishdrawπEND IFπIF Bal.Anclock > 50 AND Bal.Anclock < 61 THENπBal.AnFlag = 4πPUT (Bal.X, Bal.Y), Bal4m, ANDπPUT (Bal.X, Bal.Y), Bal4, XORπGOTO FinishdrawπEND IFπIF Bal.Anclock > 60 AND Bal.Anclock < 71 THENπBal.AnFlag = 3πPUT (Bal.X, Bal.Y), Bal3m, ANDπPUT (Bal.X, Bal.Y), Bal3, XORπGOTO FinishdrawπEND IFπIF Bal.Anclock > 70 AND Bal.Anclock < 81 THENπBal.AnFlag = 2πPUT (Bal.X, Bal.Y), Bal2m, ANDπPUT (Bal.X, Bal.Y), Bal2, XORπGOTO FinishdrawπEND IFπFinishdraw:πEND SUBππSUB DrawBlankArenaπSCREEN 7, 0, 1, 0πCLSπLINE (0, 0)-(319, 10), 0, BFπPUT (0, 0), Score, PSETπLINE (0, 11)-(319, 199), 15, BπLINE (1, 12)-(318, 198), 7, BπLINE (2, 13)-(317, 197), 8, BπEND SUBππSUB GetKeyπMove$ = INKEY$πSELECT CASE Move$πCASE CHR$(0) + CHR$(77)πBal.Xm = Bal.Xm + 1πCASE CHR$(0) + CHR$(75)πBal.Xm = Bal.Xm - 1πCASE CHR$(0) + CHR$(72)πBal.Ym = Bal.Ym - 1πCASE CHR$(0) + CHR$(80)πBal.Ym = Bal.Ym + 1πCASE CHR$(0) + CHR$(59)πIF Active = 1 THENπSCREEN 7, 0, 2, 4πA$ = INPUT$(1)πSCREEN 7, 0, 2, 0πEND IFπCASE CHR$(0) + CHR$(16)πIF Active = 1 THENπSCREEN 7, 0, 2, 5πDOπAns$ = UCASE$(INKEY$)πLOOP UNTIL Ans$ = "Y" OR Ans$ = "N"πIF Ans$ = "Y" THENπActive = 0πFOR T = 1 TO 84 STEP 4πSCREEN 7, 0, 2, 0: PCOPY 1, 2πLINE (0, 0)-(T, 200), 1, BFπLINE (80, 0)-(80 + T, 200), 1, BFπLINE (160, 0)-(160 + T, 200), 1, BFπLINE (240, 0)-(240 + T, 200), 1, BFπSCREEN 7, 0, 0, 0: PCOPY 2, 0: PCOPY 1, 2πNEXTπMakeTitleScreenπDoMenuπEND IFπELSE SCREEN 7, 0, 2, 0πEND IFπEND SELECTπEND SUBππSUB InititπFOR I = 1 TO 3πBomb(I).Sx = Fnr(300) + 10πBomb(I).Sy = Fnr(180) + 11πBomb(I).Active = 0πBomb(I).Rclock = 0πBomb(I).Clock = 0πNEXTπBal.DeadClock = 0πBal.Dead = 0πBal.X = 155πBal.Y = 95πBal.AnFlag = 1πBal.Anclock = 0πBal.W = 7πBal.H = 13πMenu.num = 1πManX = (320 / 2) - (54 / 2)πManY = (200 / 2) - 13πActive = 0πFOR I = 1 TO 10πC(I).Anclock = Fnr(90)πTor(I).ActCount = 0πTor(I).Active = 0πTor(I).Exploding = 0πTor(I).Ecount = 0πMissle(I).Active = 0πMissle(I).ActCount = 0πTor(I).LoCount = 0πNEXT IππEND SUBππSUB LevDisπLDF = LDF + 1πCenter 12, l$, 15πCenter 14, G(Current.Level), 14πEND SUBππSUB LevelClearπFOR T = 1 TO 120 STEP 4πSCREEN 7, 0, 2, 0: PCOPY 1, 2πLINE (0, 0)-(320, T), 1, BFπLINE (0, 200)-(320, 200 - T), 1, BFπSCREEN 7, 0, 0, 0: PCOPY 2, 0: PCOPY 1, 2πNEXTπA$ = INKEY$πPCOPY 3, 1πSCREEN 7, 0, 1, 1ππSCREEN 7, 0, 2, 0πLINE (0, 0)-(319, 199), 1, BFπPUT (160 - 33, 100), Lc, PSETπPCOPY 2, 0πA$ = INPUT$(1)πCurrent.Level = Current.Level + 1πCurrent.Gems = 0πStartBonusπDrawArenaπPCOPY 3, 1πSCREEN 7, 0, 1, 1πFOR T = 120 TO -4 STEP -4πSCREEN 7, 0, 2, 0: PCOPY 1, 2πLINE (0, 0)-(320, T), 1, BFπLINE (0, 200)-(320, 200 - T), 1, BFπSCREEN 7, 0, 0, 0: PCOPY 2, 0: PCOPY 1, 2πNEXTπMainGameπEND SUBππSUB MainGameππActive = 1ππLDF = 0ππl$ = "Level " + STR$(Current.Level)ππSELECT CASE Current.LevelπCASE 1πCurrent.GemReq = 2πCASE 2πCurrent.GemReq = 4πCASE 3πCurrent.GemReq = 6πCASE 4πCurrent.GemReq = 8πCASE 5πCurrent.GemReq = 10πEND SELECTππFOR T = 200 TO 0 STEP -5πSCREEN 7, 0, 2, 0: PCOPY 1, 2πFOR N = 1 TO 40 STEP 2πPSET (Bal.X + XSin(N) * T, Bal.Y + Xcos(N) * T), 4πNEXTπSCREEN 7, 0, 0, 0: PCOPY 2, 0: PCOPY 1, 2πNEXTππCl = Current.Level - 2πActive = 1ππDOπSCREEN 7, 0, 2, 0: PCOPY 1, 2πIF LDF < 100 THEN LevDisπGetKeyπProcessMotionπDoTorpedo Current.Levelπ'DoMissle Current.Level   Un-comment this for missles, they suck though!πDoBomb Current.Level - 1  'the hit detection is freakin nasty becauseπDoItem                    'I needed SPEED!  Missles suck #@&$!πDrawBalloonπIF Current.Gems = Current.GemReq THENπSELECT CASE Current.LevelπCASE 5πDoCheapEnding   'Screw the ending!πCASE ELSEπLevelClearπEND SELECTπEND IFπLOCATE 1, 8: PRINT Current.ScoreπLOCATE 1, 21: PRINT Current.LivesπLOCATE 1, 33: PRINT Current.GemsπPCOPY 2, 0πLOOPπActive = 0πEND SUBππSUB MakeHelpScreenπSCREEN 7, 0, 4, 0πMakeStars 300πLINE (0, 31)-(320, 31), 15πCenter 3, "CONTROLS", 9πCOLOR 15πLOCATE 7, 11: PRINT "Move Up"πLOCATE 10, 11: PRINT "Move Down"πLOCATE 13, 11: PRINT "Move Left"πLOCATE 16, 11: PRINT "Move Right"πLOCATE 19, 11: PRINT "This Screen"πLOCATE 22, 11: PRINT "Quit Game"πPUT (220, 48), Up, PSETπPUT (220, 72), Down, PSETπPUT (220, 96), Left, PSETπPUT (220, 120), Right, PSETπPUT (220, 144), F1, PSETπPUT (220, 168), Alt, PSETπPUT (240, 168), Q, PSETπEND SUBππSUB MakeInfoπSCREEN 7, 0, 6, 6πMakeStars 300πLINE (0, 0)-(85, 105), 15, BπLINE (1, 1)-(84, 104), 7, BπLINE (2, 2)-(83, 103), 8, BπPUT (3, 3), me, PSETπCOLOR 7πLOCATE 3, 13: PRINT "NAME:"πLOCATE 8, 13: PRINT "AGE:"πLOCATE 12, 13: PRINT "OCCUPATION:"πCOLOR 9πLOCATE 3, 19: PRINT "Manny Najera"πLOCATE 8, 18: PRINT "15"πLOCATE 12, 26: PRINT "Student"πCOLOR 11πLOCATE 15, 4: PRINT "- to scroll, ESC to exit"πPUT (0, 110), Up, PSETπPUT (10, 110), Down, PSETπLINE (0, 120)-(319, 120), 15πLINE (0, 121)-(319, 197), 0, BFπLINE (0, 198)-(319, 198), 15πEND SUBππSUB MakeIntroScreenπMakeStars 300πPUT ((320 / 2) - (54 / 2), (200 / 2) - 13), Manny, PSETπEND SUBππSUB MakeQuitsπSCREEN 7, 0, 5, 0πMakeStars 300πCenter 12, "Quit Game? (Y/N)", 15πEND SUBππSUB MakeStars (NumStars%)πFOR I = 1 TO NumStars%πMCr = Fnr(3)πSELECT CASE MCrπCASE 1πMCol = 8πCASE 2πMCol = 7πCASE 3πMCol = 15πEND SELECTπMx = Fnr(320)πmy = Fnr(200)πPSET (Mx, my), MColπNEXTπEND SUBππSUB MakeTitleScreenπSCREEN 7, 0, 1, 0πCLSπMakeStars 300πLINE (108 - 20, 47 - 20)-(108 + 120, 47 + 40), 0, BFπPUT (108, 47), Title, PSETπLINE (108 - 20, 47 - 20)-(108 + 120, 47 + 40), 4, BπLINE (108 - 21, 47 - 21)-(108 + 121, 47 + 41), 12, BπLINE (108 - 22, 47 - 22)-(108 + 122, 47 + 42), 15, BπCenter 16, "Start Game", 4πCenter 20, "Author Info", 9πCenter 24, "Exit", 12ππFOR T = 84 TO 0 STEP -4πSCREEN 7, 0, 2, 0: PCOPY 1, 2πLINE (0, 0)-(T, 200), 1, BFπLINE (80, 0)-(80 + T, 200), 1, BFπLINE (160, 0)-(160 + T, 200), 1, BFπLINE (240, 0)-(240 + T, 200), 1, BFπSCREEN 7, 0, 0, 0: PCOPY 2, 0: PCOPY 1, 2πNEXTππEND SUBππFUNCTION PointHit% (Hx, Hy)πIF Hx > Bal.X AND Hx < Bal.X + 7 AND Hy > Bal.Y AND Hy < Bal.Y + 7 THEN PointHit% = 1 ELSE PointHit% = 0πEND FUNCTIONππSUB ProcessMotionπIF Bal.Xm > 3 THEN Bal.Xm = 3πIF Bal.Xm < -3 THEN Bal.Xm = -3πIF Bal.Ym > 3 THEN Bal.Ym = 3πIF Bal.Ym < -3 THEN Bal.Ym = -3πBal.X = Bal.X + Bal.XmπBal.Y = Bal.Y + Bal.YmπIF Bal.X < 4 THENπBal.X = 4πBal.Xm = 0πGOTO FinishBofπEND IFπIF (Bal.X + Bal.W) > 315 THENπBal.X = (315 - Bal.W)πBal.Xm = 0πGOTO FinishBofπEND IFπIF Bal.Y < 14 THENπBal.Y = 14πBal.Ym = 0πGOTO FinishBofπEND IFπIF (Bal.Y + Bal.H) > 195 THENπBal.Y = (195 - Bal.H)πBal.Ym = 0πGOTO FinishBofπEND IFπFinishBof:πEND SUBππSUB SeeInfoπFOR T = 1 TO 84 STEP 4πSCREEN 7, 0, 2, 0: PCOPY 1, 2πLINE (0, 0)-(T, 200), 1, BFπLINE (80, 0)-(80 + T, 200), 1, BFπLINE (160, 0)-(160 + T, 200), 1, BFπLINE (240, 0)-(240 + T, 200), 1, BFπSCREEN 7, 0, 0, 0: PCOPY 2, 0: PCOPY 1, 2πNEXTπPCOPY 6, 1πCOLOR 9πFOR T = 84 TO 0 STEP -4πSCREEN 7, 0, 2, 0: PCOPY 1, 2πLINE (0, 0)-(T, 200), 1, BFπLINE (80, 0)-(80 + T, 200), 1, BFπLINE (160, 0)-(160 + T, 200), 1, BFπLINE (240, 0)-(240 + T, 200), 1, BFπSCREEN 7, 0, 0, 0: PCOPY 2, 0: PCOPY 1, 2πNEXTππDOπSCREEN 7, 0, 2, 0: PCOPY 1, 2ππMt$ = UCASE$(INKEY$)πSELECT CASE Mt$πCASE CHR$(0) + CHR$(72)πMp = Mp - 1πIF Mp = 0 THEN Mp = 1πCASE CHR$(0) + CHR$(80)πMp = Mp + 1πIF Mp = 39 THEN Mp = 38πCASE CHR$(27)πEXIT DOπEND SELECTππLOCATE 17, 1ππFOR I = Mp TO Mp + 6πPRINT Message(I)πNEXTππSCREEN 7, 0, 0, 0: PCOPY 2, 0: PCOPY 1, 2πLOOPππFOR T = 1 TO 84 STEP 4πSCREEN 7, 0, 2, 0: PCOPY 1, 2πLINE (0, 0)-(T, 200), 1, BFπLINE (80, 0)-(80 + T, 200), 1, BFπLINE (160, 0)-(160 + T, 200), 1, BFπLINE (240, 0)-(240 + T, 200), 1, BFπSCREEN 7, 0, 0, 0: PCOPY 2, 0: PCOPY 1, 2πNEXTπMp = 1πMakeTitleScreenπDoMenuπEND SUBππSUB StartBonusπDrawBlankArenaπFOR T = 84 TO 0 STEP -4πSCREEN 7, 0, 2, 0: PCOPY 1, 2πLINE (0, 0)-(T, 200), 1, BFπLINE (80, 0)-(80 + T, 200), 1, BFπLINE (160, 0)-(160 + T, 200), 1, BFπLINE (240, 0)-(240 + T, 200), 1, BFπSCREEN 7, 0, 0, 0: PCOPY 2, 0: PCOPY 1, 2πNEXTππBl = 10ππDOπSCREEN 7, 0, 2, 0: PCOPY 1, 2πBl = Bl - .03πIF Bl < 0 THEN EXIT DOπD$ = STR$(INT(Bl)) + " seconds left"πCenter 12, D$, 15πCenter 14, "Grab as many goodies as you can!", 12πLOCATE 1, 6: PRINT Current.ScoreπFOR I = 1 TO 60πStar(I).Y = Star(I).Y + Star(I).TπIF Star(I).Y > 197 THEN Star(I).Y = 11πPSET (Star(I).X, Star(I).Y), Star(I).CπNEXT IππGetKeyπProcessMotionπDoBItemπDrawBalloonππSCREEN 7, 0, 0, 0: PCOPY 2, 0: PCOPY 1, 2πLOOPπFOR T = 0 TO 84 STEP 4πSCREEN 7, 0, 2, 0: PCOPY 1, 2πLINE (0, 0)-(T, 200), 1, BFπLINE (80, 0)-(80 + T, 200), 1, BFπLINE (160, 0)-(160 + T, 200), 1, BFπLINE (240, 0)-(240 + T, 200), 1, BFπSCREEN 7, 0, 0, 0: PCOPY 2, 0: PCOPY 1, 2πNEXTππEND SUBππSUB StartGameππInititππCurrent.Lives = 5ππCurrent.Score = 0πCurrent.Level = 1ππFOR T = 1 TO 120 STEP 4πSCREEN 7, 0, 2, 0: PCOPY 1, 2πLINE (0, 0)-(320, T), 1, BFπLINE (0, 200)-(320, 200 - T), 1, BFπSCREEN 7, 0, 0, 0: PCOPY 2, 0: PCOPY 1, 2πNEXTππPCOPY 3, 1πSCREEN 7, 0, 1, 1ππFOR T = 120 TO 0 STEP -4πSCREEN 7, 0, 2, 0: PCOPY 1, 2πLINE (0, 0)-(320, T), 1, BFπLINE (0, 200)-(320, 200 - T), 1, BFπSCREEN 7, 0, 0, 0: PCOPY 2, 0: PCOPY 1, 2πNEXTππActive = 1πInititπMainGameπEND SUBππChris Kerton                   THE ADVENTURE                  ftp.gmd.de                     12-22-88 (00:00)       QB, QBasic, PDS        376  16411    ADVENTUR.BAS5 REM done by Chris Kertonπ10 CLSπ20 PRINT TAB(35); "***************"π30 PRINT TAB(35); "*THE ADVENTURE*"π40 PRINT TAB(35); "***************"π50 PRINT : PRINTπ60 PRINT TAB(35); "Written by Chris Kerton (C-Tek)"π70 PRINT TAB(35); "==============================="π80 PRINTπ90 INPUT "Please enter your name"; N$π96 PLAY "c4f.c8f8.c16f8.g16a2f2"π100 INPUT "Would you like instructions (y or n)"; IN$π110 IF IN$ = "n" THEN GOTO 310π120 IF IN$ = "y" THEN GOTO 125π125 CLSπ130 PRINT TAB(30); "######################################"π140 PRINT TAB(30); "#THE INSTRUCTIONS FOR 'The Adventure'#"π150 PRINT TAB(30); "######################################"π160 PRINT : PRINTπ170 PRINT "Okay "; N$; " 'ADVENTURE' is a fantasy, role-playing game."π180 PRINT "The object of the game is to make it to the end and win."π190 PRINT "To do this you will need to use your imagination and wit."π200 PRINT "---------------------------------------------------------"π210 PRINT : PRINTπ220 PRINT TAB(35); "BASIC CONTROLS"π230 PRINT TAB(35); "=============="π240 PRINTπ250 PRINT "S-key means go south----------------E-key means go east"π260 PRINT "N-key means go north----------------W-key means go west"π270 PRINT "L-key means look--------------------K-key means kill"π280 PRINT "CTRL and run/stop means quit--------T-key means talk"π290 PRINT "-------------------------------------------------------"π300 PRINT : PRINTπ310 INPUT "Would you like to start (y or n)"; ST$π320 IF ST$ = "n" THEN GOTO 9990π330 IF ST$ = "y" THEN GOTO 340π340 CLSπ350 PRINT TAB(35); "***************"π360 PRINT TAB(35); "*THE ADVENTURE*"π370 PRINT TAB(35); "***************"π380 PRINT : PRINTπ390 PRINT TAB(10); "Designed by Chris Kerton------------C-Tek industries"π400 PRINT TAB(10); "<<<<<<<<<<<<<<<<<<<<<<<<<>>>>>>>>>>>>>>>>>>>>>>>>>>>"π410 PRINT TAB(10); "Copyright 1988-12-22----------------Volume One"π420 PRINT : PRINT : PRINTπ430 PRINT "You are outside of your local high school."π440 PRINT "It will probably be another boring uneventful day."π450 INPUT "What would you like to do"; CH1$π460 IF CH1$ = "l" THEN GOTO 525π470 IF CH1$ = "s" THEN GOTO 940π480 IF CH1$ = "n" THEN GOTO 890π490 IF CH1$ = "e" THEN GOTO 810π500 IF CH1$ = "w" THEN GOTO 850π510 IF CH1$ = "k" THEN GOTO 660π520 IF CH1$ = "t" THEN GOTO 785π525 PRINT : PRINTπ530 PRINT "To your north is the school entrance, with your usual"π540 PRINT "group of wasteoids who smoke things with weird smells,"π550 PRINT "and the entrance to the school."π560 PRINT : PRINTπ570 PRINT "To your south you see the stairway which you have just"π580 PRINT "descended and the usual group of jocks hanging around, waiting"π590 PRINT "for the morning bell to ring while they talk about hockey."π600 PRINT : PRINTπ610 PRINT "To your east you see nothing of importance except the rest of the"π620 PRINT "school and to the west you see the school parking lot with"π630 PRINT "a couple of school buses pulling in that are about to"π640 PRINT "drop off their load of shit, *OOPS*, I mean students."π650 GOTO 450π660 PRINT : PRINTπ670 PRINT "Kill who!? The students? Man, you must be crazy!"π680 PRINT "But since you said so:"π690 PRINT : PRINTπ700 PRINT "You attack the nearest unsuspecting person which happens"π710 PRINT "to be a wasteoid with a leather jacket, spike bands, and"π720 PRINT "various other things a street gang person might have."π730 PRINTπ740 PRINT "Three of the wasteoids, who look tough, immediately jump foward"π750 PRINT "to save their buddy you have just attacked."π760 PRINTπ770 PRINT "They pull out a switch-blade knife and then *#fasdfsg!@@##%$@%^BN!!!"π774 INPUT "Would you like to start over (y or n)"; QU2$π775 IF QU2$ = "y" THEN GOTO 5π780 IF QU2$ = "n" THEN GOTO 9990π785 PRINT : PRINTπ790 PRINT "As you babble on to nobody in particular, a few people turn"π800 PRINT "to look at you strangely and then go back to what they were doing."π805 GOTO 450π810 PRINT : PRINTπ820 PRINT "You find yourself walking toward a wall which is part of the"π830 PRINT "school and is also a dead end."π840 GOTO 450π850 PRINT : PRINTπ860 PRINT "You are in the school parking lot with a few cars"π870 PRINT "and a bus is dropping off some students."π880 GOTO 1060π890 PRINT : PRINTπ900 PRINT "You are standing in front of the school doors"π910 PRINT "with a few wasteoids standing around going about their own"π920 PRINT "business."π930 GOTO 2150π940 PRINT : PRINTπ950 PRINT "As you are going up the stairs you meet up with"π960 PRINT "two of your friends, Larry and Moe. They greet you"π970 PRINT "with 'hey "; N$; " hows it goin?'"π975 PRINTπ980 INPUT "What do you want to do"; CH2$π990 IF CH2$ = "l" THEN GOTO 1570π1000 IF CH2$ = "s" THEN GOTO 1690π1010 IF CH2$ = "n" THEN GOTO 2000π1020 IF CH2$ = "e" THEN GOTO 2020π1030 IF CH2$ = "w" THEN GOTO 2020π1040 IF CH2$ = "k" THEN GOTO 2070π1050 IF CH2$ = "t" THEN GOTO 1770π1060 PRINT : PRINTπ1070 INPUT "What do you want to do"; CH3$π1080 IF CH3$ = "l" THEN GOTO 1150π1090 IF CH3$ = "s" THEN GOTO 1260π1100 IF CH3$ = "n" THEN GOTO 1320π1110 IF CH3$ = "e" THEN GOTO 1400π1120 IF CH3$ = "w" THEN GOTO 1410π1130 IF CH3$ = "k" THEN GOTO 1470π1140 IF CH3$ = "t" THEN GOTO 1540π1150 PRINT : PRINTπ1160 PRINT "To the south you see a muddy field, the school sign, and"π1170 PRINT "the street."π1180 PRINTπ1190 PRINT "To the north you see the end of the school and a moving"π1200 PRINT "bus."π1210 PRINTπ1220 PRINT "To the east you see where you have just came from."π1230 PRINTπ1240 PRINT "To the west you see the woods."π1250 GOTO 1060π1260 PRINT : PRINTπ1270 PRINT "You are walking across the muddy, wet, slippery field"π1280 PRINT "towards the school sign and the street and !@#$%^&*(((!!!!"π1290 PRINT "woo!!!!. You slip in the mud and hit your head on"π1300 PRINT "on the metal post of the sign killing yourself."π1304 INPUT "Would you like to start over (y or n)"; QU1$π1305 IF QU1$ = "y" THEN GOTO 5π1310 IF QU1$ = "n" THEN GOTO 9990π1320 PRINT : PRINTπ1330 PRINT "You start to walk north and notice the bus you saw"π1340 PRINT "is coming straight at you! Apparentely the bus driver"π1350 PRINT "does not see you."π1360 PRINT "You trip over your own feet trying to get out"π1370 PRINT "of the way, you clumsy oaf, and !@#$%^&*()!!!!!!!"π1374 INPUT "Would you like to start over (y or n)"; QU3$π1375 IF QU3$ = "y" THEN GOTO 5π1380 IF QU3$ = "n" THEN GOTO 9990π1384 INPUT "Would you like to start over (y or n)"; QU3$π1385 IF QU3$ = "y" THEN GOTO 5π1390 PRINT : PRINTπ1400 GOTO 430π1410 PRINT : PRINTπ1420 PRINT "You go west and slide down the steep bank on your"π1430 PRINT "ass."π1440 PRINT "You are now at the base of the woods."π1450 GOTO 3230π1460 PRINT : PRINTπ1470 PRINT "You take a swat at the blackfly buzzing around your"π1480 PRINT "head and with your excellent reflexes, you"π1490 PRINT "manage to squash it. You notice blood spurts"π1500 PRINT "everywhere indicating that the blackfly just got"π1510 PRINT "done feasting on your arm."π1520 GOTO 1060π1530 PRINT : PRINTπ1540 PRINT "You find yourself talking to yourself and then"π1550 PRINT "realize, am I going insane?"π1560 GOTO 1060π1570 PRINT : PRINTπ1580 PRINT "To the north you see the entrance to the school"π1590 PRINT "and the few wasteoids that have not gone inside yet."π1600 PRINTπ1610 PRINT "To the south you see the top of the stairs"π1620 PRINT "and the odd person rushing to get to class."π1630 PRINTπ1640 PRINT "To the east you see the side of the school and"π1650 PRINT "to the west you see the school parking lot and the street."π1660 PRINT "You also see Larry and Moe."π1670 GOTO 980π1680 PRINT : PRINTπ1690 PRINT "You go south which is to the top of the stairs."π1700 PRINT "Here you see the upper parking lot where most"π1710 PRINT "of the students park their cars."π1720 PRINT "Apparently Larry and Moe have followed and ask"π1730 PRINT "where are you going?"π1740 PRINT "They must think you want to jig school today and"π1750 PRINT "they say is sounds like a good plan."π1760 PRINT : PRINTπ1770 PRINT "You ask Larry and Moe what they want to do today"π1780 PRINT "and they say cut class."π1790 PRINTπ1800 INPUT "Do you want to cut class (y or n)"; CC$π1810 IF CC$ = "y" THEN GOTO 1880π1820 IF CC$ = "n" THEN GOTO 1830π1830 PRINT : PRINTπ1840 PRINT "Larry and Moe say 'What a Bummer' come on "; N$; ","π1850 PRINT "let's go to class."π1860 PRINT "You go back down the stairs and towards the school doors."π1870 PRINT : GOTO 890π1880 PRINT : PRINTπ1890 GOTO 980π1900 PRINT : PRINTπ2000 GOTO 430π2010 PRINT : PRINTπ2020 PRINT "You hop over the stair railing and end up catching"π2030 PRINT "your foot on the railing, roll down the hill and"π2040 PRINT "the next thing you know, you wake up in  a hospital"π2050 PRINT "bed with a broken spine!"π2054 INPUT "Would you like to start over (y or n)"; QU4$π2055 IF QU4$ = "y" THEN GOTO 5π2060 IF QU4$ = "n" THEN GOTO 9990π2070 PRINT : PRINTπ2080 PRINT "You grab Moe and try to strangle him."π2090 PRINT "Larry hollers out "; N$; " what the hell do you"π2100 PRINT "think you are doing? You manage to snap Moe's neck"π2110 PRINT "killing him and Larry picks up a big rock and brings"π2120 PRINT "it crashing down on your skull with a crunching"π2130 PRINT "sound...!@#$%^&*()!!!!!"π2134 INPUT "Would you like to start over (y or n)"; QU5$π2135 IF QU5$ = "y" THEN GOTO 5π2140 IF QU5$ = "n" THEN GOTO 9990π2150 PRINT : PRINTπ2160 INPUT "Would you like to enter the school (y or n)"; V1$π2170 IF V1$ = "n" THEN GOTO 420π2180 IF V1$ = "y" THEN GOTO 2190π2190 PRINT : PRINTπ2200 PRINT "You open the door and enter the school."π2210 PRINT : PRINTπ2220 INPUT "What would you like to do"; V2$π2230 IF V2$ = "l" THEN GOTO 2300π2240 IF V2$ = "s" THEN GOTO 890π2250 IF V2$ = "n" THEN GOTO 2360π2260 IF V2$ = "e" THEN GOTO 2440π2270 IF V2$ = "w" THEN GOTO 2500π2280 IF V2$ = "k" THEN GOTO 690π2290 IF V2$ = "t" THEN GOTO 2550π2300 PRINT : PRINTπ2310 PRINT "You are in a hallway. To your south is the"π2320 PRINT "exit, to the north is the rest of the hallway,"π2330 PRINT "to the east is the entrance to the gym and to"π2340 PRINT "the west another hallway with various classrooms."π2350 GOTO 2210π2360 PRINT : PRINTπ2370 PRINT "You walk a bit more and come to hallways"π2380 PRINT "at your west and east. To your north is another"π2390 PRINT "exit. At the ends of the west and east hallways are"π2400 PRINT "exits."π2410 PRINT "The hallways have various doors which are classrooms,"π2420 PRINT "and the library is to your east."π2430 GOTO 2520π2440 PRINT : PRINTπ2450 PRINT "You enter the gym and notice that a class is in session."π2460 PRINT "The gym teacher asks you what you want and then says"π2470 PRINT "please leave and do not interrupt my class or you will"π2480 PRINT "get detention!"π2490 GOTO 2210π2500 PRINT : PRINTπ2510 PRINT "You walk up the hallway to the exit."π2520 INPUT "What do you want to do"; V3$π2530 GOTO 2580π2540 PRINT : PRINTπ2550 PRINT "You babble on aimlessly and a couple of students"π2560 PRINT "turn to look at you strangely."π2570 GOTO 2210π2580 IF V3$ = "l" THEN GOTO 2650π2590 IF V3$ = "s" THEN GOTO 2300π2600 IF V3$ = "e" THEN GOTO 2700π2610 IF V3$ = "w" THEN GOTO 2730π2620 IF V3$ = "k" THEN GOTO 660π2630 IF V3$ = "t" THEN GOTO 2760π2640 IF V3$ = "n" THEN GOTO 3100π2650 PRINT : PRINTπ2660 PRINT "To your east is the library, you just came from the south"π2670 PRINT "to your west is nothing of significance and to your north"π2680 PRINT "is a water fountain."π2690 GOTO 2520π2700 PRINT : PRINTπ2710 PRINT "You enter the library which is a typical school library."π2720 GOTO 2830π2730 PRINT : PRINTπ2740 PRINT "There is a wall in your way!"π2750 GOTO 2520π2760 PRINT : PRINTπ2770 PRINT "Do you like talking to yourself idiot stick?"π2780 GOTO 2520π2790 PRINT : PRINTπ2800 PRINT "The door seems to be locked! Dam it, shit, darn!"π2810 PRINT "That really burns the shit off your underwear!"π2820 GOTO 2520π2830 PRINT : PRINTπ2840 INPUT "What would you like to do"; Z$π2850 IF Z$ = "l" THEN GOTO 2920π2860 IF Z$ = "s" THEN GOTO 2970π2870 IF Z$ = "e" THEN GOTO 3020π2880 IF Z$ = "w" THEN GOTO 2650π2890 IF Z$ = "k" THEN GOTO 3040π2900 IF Z$ = "t" THEN GOTO 3140π2910 IF Z$ = "n" THEN GOTO 3180π2920 PRINT : PRINTπ2930 PRINT "To your west is where you just came from, to your"π2940 PRINT "east and south is the rest of the library and"π2950 PRINT "to your north is an exit."π2960 GOTO 2830π2970 PRINT : PRINTπ2980 PRINT "You run into a stack of books knocking them over."π2990 PRINT "@#@@#$^^&&%*&*(()!!!!! too bad "; N$; " you will be picking up"π3000 PRINT "books for the rest of the day! Idiot stick!"π3004 INPUT "Would you like to start over (y or n)"; QU6$π3005 IF QU6$ = "y" THEN GOTO 5π3010 IF QU6$ = "n" THEN GOTO 9990π3020 PRINT : PRINTπ3030 GOTO 2980π3040 PRINT : PRINTπ3050 PRINT "You try to kill the librarian who is big and fat"π3060 PRINT "and she just knocks you down with a big swipe"π3070 PRINT "and puts her fat ass on your ugly face killing"π3080 PRINT "you!!"π3084 INPUT "Would you like to start over (y or n)"; QU7$π3085 IF QU7$ = "y" THEN GOTO 5π3090 IF QU7$ = "n" THEN GOTO 9990π3100 PRINT : PRINTπ3110 PRINT "You slip on some water that has spilled out of the"π3120 PRINT "fountain @#$%^&*()!!!!!!"π3124 INPUT "Would you like to start over (y or n)"; QU8$π3125 IF QU8$ = "y" THEN GOTO 5π3130 IF QU8$ = "n" THEN GOTO 9990π3140 PRINT : PRINTπ3150 PRINT "Talking to yourself causes people to think"π3160 PRINT "you are weird."π3170 GOTO 2830π3180 PRINT : PRINTπ3190 PRINT "You go through the exit meeting up with the principal!"π3200 PRINT "He thinks you want to cut class and you tell him off."π3210 PRINT "For that you will be spending time in detention all week!"π3214 INPUT "Would you like to start over (y or n)"; QU9$π3215 IF QU9$ = "y" THEN GOTO 5π3220 IF QU9$ = "n" THEN GOTO 9990π3230 PRINT : PRINTπ3240 PRINT "<<<<<<<<<<<<<<<<<<<<CHAPTER TWO>>>>>>>>>>>>>>>>>>>>>>>>"π3250 PRINT "                    -----------"π3260 PRINT : PRINT : PRINTπ3270 PRINT "              WEIRDOID LAND!!!!!!!!!!!!!!"π3274 INPUT "Would you like to begin (y or n)"; BE$π3275 IF BE$ = "y" THEN GOTO 3230π3276 IF BE$ = "n" THEN GOTO 9990π9990 CLSπ9995 PLAY "c4f.c8f8.c16f8.g16a2f2"π10000 PRINT "*******************************************************************"π10010 PRINT "*******************************************************************"π10020 PRINT "* What a shit head you are "; N$; " you got wanked or killed!       *"π10030 PRINT "* I hope you know what mistake you made and will remember it next *"π10040 PRINT "* time.                                                           *"π10050 PRINT "* Please do not list this program. If you looked at the solutions *"π10060 PRINT "* then the game would be no fun. It is recomended that you just   *"π10070 PRINT "* play the game normally because C-Tek does not know the command  *"π10080 PRINT "* to keep you from listing this game. Keep an eye open for updated*"π10090 PRINT "* versions of this game.                                          *"π10100 PRINT "*                                                                 *"π10110 PRINT "*                                                                 *"π10120 PRINT "*=================================================================*"π10130 PRINT "*             ##THE ADVENTURE##  ##VOLUME ONE##                   *"π10140 PRINT "*=================================================================*"π10150 PRINT "* Nice try "; N$; " we hope you liked this software.......          *"π10160 PRINT "*^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^*"π10170 PRINT "*Designed by Chris Kerton-------------------------C-Tek industries*"π10180 PRINT "*<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>*"π10190 PRINT "*Copyright 1988-12-22-----------------------------------Volume One*"π10200 PRINT "*******************************************************************"π10210 INPUT "Would you like to start over (y or n)"; ST$π10220 IF ST$ = "y" THEN GOTO 5π10230 IF ST$ = "n" THEN GOTO 10240π10240 PRINT "What a wang and a poor sport you are "; N$; " see you later asswipe"π10250 ENDπA. R. Crowther                 AZTEC TOMB PART I              ftp.gmd.de                     04-17-95 (12:44)       QB, QBasic, PDS        321  21221    AZTOMB.BAS  DEFINT A-Z:DIM SHARED K,S,B&,Z&:V1 'Created by PostIt! 7.2πSUB V1:OPEN "O",1,"AZTEC.ZIP",4^6:Z&=15661:?STRING$(50,177);πU"%up()%9%%%I-%W4A$Cy.<il2ad%%k\%%%.%#%%f)%yjhS[gfxePLV>*Ule$b/OjπU"OQ5/o:GOz-mX$MpX5iXs_BWYY3a0QGH^pI4>vT)0R#DF[nqkUfm/ip\N9#cQ,k'πU"QgcYee:QVsX&Wg7Io+XI2(ls98q?BtoJVAj=s&/LsLmy\JNN,L=/E$k:ta%0t$vπU"s1zly_o$yNnmow&#WfS%=U[zV)KSI:&h>=+6)LmQQOcrSK6QR+KQbp>Me^Q;xMhπU"dKzVm%\=dg;=xq($UCUa<.:'FSJ$YntYU>Gk]8?HK8Icwh\(A-F\F5-4+IX$P(LπU"upSdTr(a86tIv?.tlPB^fTIM7rvKnsfG4=7bAn_Yk*PF7r0LrNQT]d:j\AF'P,8πU"#bqKFt.nzjkcloFzP<B:TTJ.J\lWP>W5oB\AoKdTb\Y:(7Icns4/G>W9hg[E-7NπU"ol:&V.uraQdXNlZI%wItHt?.pP_\CZlff:=\'63o9?2kuCodXbtA#T;NJnTW'.6πU"#bB$_FG;t+LumkGdHHWIN?lsG487S0TQh5KjVKnKLMf;bj?TX4or'.6+flWf3foπU"BAf^Kp7X-URF\>-VrfM$KFVrBErt90Nw$oT\1mq&-2o'szKJ-MVOyq3KZT<e&&fπU"4_d#$e(F&75Nv%6Zg0bLc$NGFrb>b0]f#+cZ.fh,DH4F)Jst-(e?pM=COLZ<;b:πU"]T1nXCx77br)gFsl=L7L\1GiBp,Ve0U\fB*vaH2>w$hMUM*O7kJUs6)P5u/H,hAπU"[Dj+b[d0TQ$BB307yilg>Cyf1I8Q5FG,dN$>z;xEudUS2*q=Jc12jjB-)dlJA6RπU"rLi$x*;xs1kaz\nWat?:^J-W>p3G,B*.>gb<B8f?JHC1kXi:ZbbqnX>nmiY4^WCπU"9OOCRzJ0)MLn_5%2H\Vjz<3i(5>%%+az(b%&i3k/NkOu+dW5PXsQnjCu[YB//dfπU"q4i7RdZ5x;mln/KreIF2)4CEtf,s=&:aU/3r]?FM)&%,]?(b+KXL.&2Q.O(:$Y3πU"E[G9/1:jRO=%g*B*DV12N0km%HcG:P%zVoa_i2r([2hJ_J,V9OlA-^\m6f,V:NUπU"A,kIj0441ti<UM-?\]J=A(KzcrLN^S?b<<n9ssbeCBgCIzh%&Z,Xe#\O<cBM9F3πU"8hezW&_%TYXr[y.A(xRy=,x-zJc)BU8Cqe3cZ,C;XK.3'8ZN%MEM:8((:zH_5P_πU"P3e3'33bZ6J6kkv3J]ZP9b+TJ(hsV]gT)P;%]A]#GxmsAF.$/'yVoVUx\OB?^L^πU"E(k<znJZ();m'K^/d1JEAy?tBi2)257ZZa?KIxI8fSAmHaZE3&Jm^5p=,BBZ)/^πU"5x2Mm[8<So2K\(:fv#MlRDL05c%0H*%t(Y:SOFrJ&:si)dNp7SnQlNNk;_ftc*jπU"ONr/as,l;XXUGcqJ]%L]>aX]E=#E^YGsmYY=_qIMejh#E;AT(f<g-6CW1K0bCK5πU"?cQ%OOB2ZuTfXx>31SyYrnsJM_pEb<LjZYx=4ibXw$N3?xWuj[Yb)?$j&%W160dπU"[LA^](65QIIL=W/wKd&;P(m<G?,X;]3L_q7/M&+*>pGSrM3oBefZv.+Q.OB\>N\πU"6J9[D\4s2LP>3-BCk\qLD4V*,Hdqf]Z7c'f2fEuv%Mt,a(J?M#>lV-o*iaU.k&FπU"]AtyWrCZodc(_=6A,l%T82/N:(t*dv^b]//rFD=mL>hH8vmG6H?,qASD\ECzF$5πU"MFy^dAW(D8w+GM,W&jo76sLQqL*FW)uAbpP:jalXc#_:oFY'rdJ$x#nmnOU<wl<πU"ZK0q6k-0mR^oDrDCu3jb0UXD)kGHdqLZk]gL(kLb^B48kfFAVaR6H&*P08+AWFbπU"dmgb$aP#J.puL8+wG&/A8;dT/Y>VhXu#.6_nKPOHE5^>4AZ?.?c'ck&fA]i=,;'πU"SH>lQbl*+QaRHN+GkR89-9%0y1PyAv><_?8Or'H=W-<4ge#B<;fbm;ghgd&qE5OπU"k-WEC3t_HAIoj1&TfT%a'5=B_ce(sgO\_qf<EQDl2BN<yHLdP4<>8.6GXQ[([pDπU"fv(%Bqn\NV-:^Y]B:R(k-N2fEQNBNov_wstDunduqdPjuP(\(uxWjPH(p4Kr6NYπU"d0v(e35K6NE:tLx29t,wHE=.t]L3)8dYYuBz9:st_-wsDIlwCM+De0d(q:4K75]πU"8MB5NvNXcwc=7nXZ\$sSgvxg7NLkeX7P6?4fl0;=8*m-Kl0:ZQ24BPM:vnZFquQπU".ld*0?'41iTOwQB-t]8S/8L\LtniA,2sd=IjIi+8CqmHm/&ItJOPFt8mtcZDZvRπU"lNj\lnxBL*'NjCNb1_b_d=T.StL>0wBL#AO4cDca]]fq/fDWg_cYCyVJGFGNx'2πU"P3xcH[9TVJu+%y-#)Fo%RP3v&Uhmx'DGZQ.zu=:U(*_x]'Q5v3fG]HRwzRkYa_YπU"Y'+^_67wjRugGs5C9_eD=M4BKP1z4BGC\?'$;9cF.:j9Rm/\iyM2j*AONiVvIVqπU";'2\s_7d63'73,icoQZv\2q%Cav[)&+GZ3T=_O-C?Jztx1V1&y)YZ3T=OZ$CuwFπU"JE8xMKBqDL2eYDw82jRaGfx6xhq;mh;Hm\.arnzRi5_v*(y*LpAmtx\3+HqZ?vUπU"+*jJacXHu_\mJKGq.jxkf=hZe'$N7KMpSlSKCnV=4$cTb7X[]t&P^;f-X#ED*30πU"$WT]U&vWp(tFSTa;b<q_sOu*q#OFGD4i;#.s$[:K<G]q0Snv66Pd3H'2yQ:S&wCπU"R)NTx(ENI?>L9R16:P<(eG)SoYN-'$7CAaY*TVp]*V#Rw:#xeH=lJtAsFwJ2Z*&πU")wram3o/3KCt=s:d.N5S[y#+n0-F5T+7qpO=43q-CD>T-sl+Rt_VqV.+&D'OfGMπU"meHVe7Ij#P?'M[kES+NI%&J4m],&:c0kO8['GTY#[Uc[Y8b'%OJ8[7iAw7%.3\'πU",J_4(JVbG2sl%PSLY,z[o$$WqD&+Y&<PpyS_S%_yub_-(nSj9N<#CRw]w>h+%>GπU"eY;f2::3^DXjB)]?2o=FP4z^kjVq\L;*#Fu6aq>qsm-Oq(ix]%8:vT[<NY2gyCQπU"[5IU-s1\8-v/#^\NGyEd,Z815(_zRm>J_7YMu)U'&]%JY0P95+:dgJ=>Kfz7al^πU"FI6oae:[jOM=S1oi3bZg+cv.1ifFhkJt1^;F89<(vn)MAzDwB]PjfZ+'P%.Np^7πU"AXCjcVcd[9iSU%m;k1K%j2bs%fNjU&l1LXP&gKz'iOE&G1TSZpM5BTqpD+Jvq/XπU"$MsqTVn817LAa_bKvK3*h<$/YPb;%bk1lBOHCb4w#$FWPaLgA$=EDm>If6aX9bFπU"*vs*WXYT\l1.k7i-duX)YzqPPbN)vq$='Mb7reHV8x$f+mU*FfDpsd')c.XM3XsπU"DKsH[edmb4e)xgyk#OF:>K,jw?D5=2m(F4tXue?DD-BCo$_=tNFo/C()bHP6EHYπU"wAhZh/\d^Y,s[e%b=>NVsm+Y[dVEE;yc-k=PyjlkC%5sCPdbV9vT-krbjnoN?^0πU"=v&P=4pP3nF01;Fq&9Fm\1wrTPcpI)r(DcDTbpXYVpd48##YIx:T>OSqtjbcWc9πU"S5/kabxnv##Xrg=>n)d)1r)k%.F41abktd[uC=72k?Vzj.c__9$fkC[)6lO5g%BπU"NSKlrq1kPYj.g)TKJVGUH8Nya#dn6H.Ks*onI7Qh,>vNHnFO2#>-s?qvHPL/CHHπU"Nh=Ca1f6vzPE\=\=^eX[4ks3m/A7f?oVJ*mHL$8s*k#&j=5,KXTt$1,:B>1rml&πU"FI6Q.R(>$.bs6u//7Rl%P%KBFs:95rJqJ0fKzYu(NFcpkzObqK:,J<c;N?E.5L8πU"oN\P_HR:L*$GG*3X+]$cBARunaJ+iONOoMgPL^_6q>Lhsl.P>WjElNpXjKR;IIUπU"/+1G8beO:&_=oUoA;knw1+uAQ1]cR.9GcM2J8f-iy5praNgor*s6:mk>J.Ok<z:πU"ah8Y=t3dn)bcp&ZDIL%KYad#SZ.3d$MzNFE2j'g/Cfd\Gx]Um<LSrJdj9N4\jyNπU"'B*q;)-V$BS&c[R6o-?s]t1Kg9=V<^p0u].$WVqugFg2JDsQ)3WFc8eh[alA0-5πU"APwO;KrTWUUbA7nI:9]5)*U*_bM9:sQRH\5G$'^0H][Yf#E%8fzER(r&S^3ePV]πU":QxhSGJ_Pq1WXjU'8Sy;cN(;x+FqZ##0s>MoXwN9aPqAEDYs6>#IBGV2;a-qESsπU"(d*V/:7hKTk=CT6npl9c>J:tI4%?b%Y:P0)VYT.<Bq]lL:o8s*7,LDZ(L;QQK#nπU"2)Hb0p<W8Wiv+Pl4b54T3sSj'F3n\<4sO))\q*_u8)//oAk)FGE,(4flo6HUkdIπU"D7>;ABFngGA*)CA,j7_hZQ9??sGOe\xAD-aLqUXZ_Ej$d,XS=G4l:nQCmlIU+)yπU"';lRPBlRpatQ5ujx$E0O_[c.Uub?&(nnXfVGN>j)kT/4^YUQTbDUrK[?#4kVn3JπU"n$(',V-wmc;D;8iZ'5?47VKOk^z[,Y+m+wY89P$<l'5E77mfXIIcRY&aIwG$NGGπU"+*51m\OWiD=3U1Q5ud:u%ktZI_Yo%_%>D.g<D76-p4^KoA*]K_7D:z1Nx^Fel>;πU"AZ=8&1VCgH%-3K[bR;HM/Y'=$'':'-o-eTB5m*Quw>84Za4#(kIUV]s?59spuXIπU"+uiW-A.-;cOE9b*p:Vc#*LlE4$2?:#vr/2AqO_+\HOZA5%=oU7iG1+w:sLe9oXXπU"l367$eGZ33ma<anANV#w>CG2;OS861%5Tqn.1.8')Y\&8FT5nvmU>sj'jT:Eg%eπU"jo-\noRRbJK6ky#HlRSLOo:#f5;>fWL'dX9^8f<wkeg9iTN\2&F5WzG1t[H33cvπU"_C+==snM\:kc<,$=S%?Uz663HEMl%3$%$Qq$G^9=Op%u6]QJJbpS/iEWYhP:YdlπU"b+I3Z%?q]cCc=\YYdqilSpDF7O2l;HnaNZ[0c%RpopJcCnfYaLqpR8G+.A%#NgyπU"Yp-d;%D6pO/#Hbt9n3Rg-]Q55P?SHL0E?8YC&%iqKFgS5928Kx3/0sboGNCMvS,πU"q%eg+2,Ei99,%)h4r7%E7pFKU7yi&aKf?C&])y+qPf95w4c6Oj>s?dZjolS?vxDπU"TFS_1l.LH1Ywe'xe9S%.OeOLh]dL#hD=$<x;/QP0_cf=NWKe)M)OxJ]'KYQkgjZπU"$/Rq/%8]WyVChvW0N7]w*E3I1o?c0>e3i\&Ad?H,c4;x]($]3?oi,'MrxN+-**sπU"L+#-r:,#VAc*Ev/7;yaFp,ash(pui$M?6Bd.of;ceaCKLYbRuBiq/sV8p'*V^F1πU"552:2h'+<G3G$B&82mzVHa<nEH%VMO:ZLMgs-f/bP;H1o;3lLWK8HL;d8S7qaQ-πU"c_<;5HNm%LnmXZf'Pi;:sLo>y.13L+t&A$B4)bMs\SPNYhRiWEXk6^[BI4)KM.OπU"UNa/ukgvgDVwD:BjuDAV5.Yrd8t'lhdr*Zo5_5iI&D7xvAjB;z2:t*n-T'P,aZ4πU"H$dKtF39Og9j9PJ+07fJY2B6In,&z-mv8Qu)2LZ*(mX03lg<GVAjkh^kQ)CJaaeπU"2_7Ia<rjLiERdF.s\rgqGqmIK1Fgd=2$%Q/sVt2PT-U[h7[BmKYw$)mwWqkSn>?πU"],f#>2kC76i_BB/VkWP9N01s9QOsK(1^O[l7:8()ED6VYbD3Tew>sF9<r\5&,MmπU"C'.6:l8cUX?a'=BFle\q-ZH%TNExXM#F8S:aniM)j80f+zzPd.)Wes[?,*3\pPwπU"^$R:_2=HG;foO(,^n6+:\y3*%J4ltk/X^>kl<lmOASA:R'i(XG/0_vd\Qja.rDYπU"CG-f?YQWv]ns;lOlA8bO%,5sFSI=9T&f%qOJaRW3fY-$n8=ku9$,:m(A^7x#1LNπU"q9+BnKa)jA.<AB,7\Hduh4EP]0]lKWfF%$U0hfp)vq&s5=NIsmsL</^&mHf.CK5πU"5EigE%_a$5nS\uHe$Gq;kC;m]\n1XW%ii;T?E_\rVOuT,m;n2)8(-lSx\5>KQmsπU"jl+qad48o'NYunIgOL0s/^4H&P_3Gl;f8W)<jd-qJwg#]<K1BiK_88Rr1on-;clπU"T-v)LKWMW>/''4Y<p&)BjE3hhE*4mV5C\k=+kU:VO1_/Fo\qa[LT4CR(V2ai71HπU"g';.&#UV'+BYQ(Nm<V_9U=:h(:oM;;iE%FP3DRg=hl]D5f.qKrn8K+NKZT;j[T#πU"%-QOAV%3z\_u+CB3V49kWcQnG>898bI#A$HfJv'H5.SPTib0Tk&\]&,L7-O:UeCπU"BHj.naM:+2Bp_zJ7m-a]k;c2%T)qJUV6*:CCR;j$0O63sx<^;\)F^L2*8\$B(]pπU"BlO.I1;_H=qAi<['.03<[&QJ988*cr)V;DF_kc23wx)p2R;m0C$6HJVR$V*tW=KπU"WuO&v7$O/NX<U9$^<>*5#%fJ.U,/Xxh$'xiTK1Mj<$aT^q,8$kPaIw:g]W$DipUπU"'[M-1kgo5CJM*E7irIeJL9CP<\HBocg5&QJ160asH#%ZL;J'Ij9s(fu+h7Y?r&'πU"'t\uJ\'^uPSxGk9K4IUjN;)0DGgwqaE0%R%6/JrLx=ZzOm]cw1=(^TmKa-P7JVeπU"/fIHyDmIf,uSca-$DscDEa=M_CNOQTGt50E,ht0GES[$<oO8r0:?9+$QT#(1I_WπU":$WMi&]VENV'3(9:XpN>I4T*[7vnAjGS&1?0YUDx>Ry4%(w&LSy^9fR4(O+:JrhπU"]AGQj0n0&0BG[hoTn0DveS/sRHq;/pn.(^v-qR/1<J[vz$COY>(QR,q_,(+/a\?πU"h+c?.NcH<3eWH%GeT+ECk-IgyMWIYR_qO]Q(ReYh9-Yk7=zdKWfWeC*Ysa(_m&WπU"khDn25<%O,GvEUK%-8sI)CJc6jGdXPzPbS)BzjrknXGWPw*oSE3M>&muE_u(*--πU"4MiaNDeD$ek<3rAi.dl-^G2et6e[*?F0CUu04,(o]3+*T16ph2lR*C+r-k%3<NHπU"QPF2EZX\hSFY:19Gv>1qP6#Rqo^L0o=*q.M+n#]n+LH(:EnKX'GP1_&&n&Rn_d8πU"/D(ccWi_rC:ONr8O?Sz7lL=-u(irOR.*Snb((Bp;1[2OJGZE2-l87B+/(8GuBBcπU"WMa1,Ki%bh#h_r:/d7JM,l)w:+_LGVq$;$('5bV;oL71t-E*Yi0'gfW5_Tb17ioπU"^?Y*'MN>b18^lS7/zTPlpfSrNo/>Flc.%D+?'(a^qqU%1Hr,alY]qY*,>:AFT]qπU"4e/:+fVlb+<+Jj+QsC&;CF^pARX5HF6Q_UukFm\78aKILE].L[;d,F-gNj\)\OsπU"jo(FiIQNJ33$43%cmATGPe$[woU/:b;w*54'N0/KI2p<N;Z>0UzBm%SP8]=Y<s_πU"#5*P#D;?5UO)(waC6+hpq\oEN11JuW-,91BN;EU)UxUd;0o_y,'4a^5u#mEIA?uπU"Vy.o)$gBOi:+:z1VxNu?\Itz1r.XF](GdGC3EC4w?gY4_bl%JE]Sa:+ViT=B+uQπU"(qaJLsWn&h'+VF)]f-0tBSV477=mw]mo)H1gt%1C?x*7-&xS3'N$])(/UWTE\KbπU"=K(JK:aO+]RP>aK:EfCpgdqftu/dW$d+B,wOq62[adns=&tpXrC614slRCRl%l3πU"n[JL%0x1r0]^&t$n1N(oiQQdrno2Jv)lllEomI1Zk2F>>a,l>6MHuBfix#/vNy?πU"E3uW4&IZwKiQlg%P_FexCtp#7,A,\WdaTz]%Mo4_O%6IDr,-0m4Xm\/F5&CQnT<πU"s1g'_rDDmpWr$c/A6^8J1lprHi-;j('/0veC.0aEpV't0(lTu5[SJ//Sp]JyJMgπU"yA?o&O^[%K)Vn8RLaJ*)%NK9Dk2.X6+YhB1^vAzjfAS_SGF%05gB[BKMn9,%'#aπU"$ceEfKkP6IES5K)*kG>kuRharZ;y(1J&)ylE-]OQF[yIlUdEt\<gWYp&-#FZM1dπU"Zt>&]Q;<$oxLf^s$l/d$nD,,l)3#P%e,G=sOv2J\>&%b/=Y*Z%prgiD;%h5Q&&qπU"I1;O,Ft]YOt*%%0:%l56qvd-PN\%Vfp+g*\U;%FZ/(a>*4fK>J)K$RKt\1nE%X[πU"(b?mF93ibF9FPSlhP;$>\BI8DhMUQEVs7v?21u$A_nclF0Ral>7rPIU=Pl':]eiπU"&)FVfG;V.MKs0]%0+3D]^f-<*AXo]lG^jL5\#rpd:b8T;bj/S;&9)2Vf5S(,>PSπU"K'n3?YgB--5\u:F&E(g'pGm[l(&nLKPlfS9p[>wHdf.S:oqE)Vaaa<]'Z-L&5c+πU"kq'#b?^U[*>>L,]U36ZreJcSW(-bFVIkG6N+;*CHk8QL6$:S(A+B>3i[_h(s]kmπU"f:Icr<D/>nL'G5<L=B_R;f=]cewM31-,cR1oCR-6Ya$crcsKpO&7T)Ddh1eUHANπU"0$c2/Ii4kCK?;>s]mUhK5a_:AU;hh$^.oR)_f#)]zAu%n2eps+AHdP.]CPM.t.BπU"L+W%&Nj#G,NjQPQnYFi5znQ40o4rX&=ry$65Y7=/4*vzaQ7&W3Rd(.N.%dGfEyiπU">G9p^)/=:*S]SB[go+ZP^0mJg]>rY=Z\+PLrnbt)RDW79gabKU5)Sx:j3eXr2(dπU"i<DQX2d/#)TG<);8X1)d[BK7EVe^#KUZz]9]nckl=yNXur<-Y=#8cM=qWD0?7ZgπU"jdXw+7OCN7]S]fq2qn9/ABNJY%1(?tZ3Kv^9C1$M)u:NhP<>lD^'q\YUIk*$nO<πU"T)2IK.BEnOlG&>p.#AAkHcqvV5EKOOjpu&EUPgqp=rfSZ8P7_Qu'Jvg<$'jM;sJπU"f0^0*Zcn,j2dG3l>,<g;+*?HYi.^o3.m;bjhcjN/\ps+URoeFdvCMA4ziDH(Hi6πU"zlIabOOrG?S;[;:c7#X[ADhZ249<mlj]XO$e46g*66')AnhmD#%m8o[)Op-smYhπU"JUAQBDlW,HHM$(kKkoO(N'E])x:q-QvP$*'D'mX1ccg#)#<S\;kfIA$ZF]k1+SHπU"j%NpB]>6EMU)4<A?kiWt/D;YBRu[5FUpIPc37c$C40e5)%kwo.-f,hg;'BbBm0PπU"fDQ+H?'cQI9Ophm/#U++.fdm.m$)tdbR01]Jr;%:V31]Z7\7DDHYoDJ6*AfTpY5πU"H='T=%g7vOw<Sb?4(Dctknonu9P&:tPA1Lmn_Hl3ds?3Kgj40EnW1S[Jz3Q&rutπU")PjN\6o9%e'H#F2j5V*AT3o,ZD;]3As&v$xggsK0xB%G,'A3V3dFHoIc7,jBa;[πU"<f)&uh=btieY-r)%]:guMUK(cV+,RonU0+lH-c)3x-e;ta_'Sd_#gYx?F9#'VH2πU"L_2C*6d.Igb9Fs0+2=jWOt_8x]rvXqJ<b1,-Z8vc/*nB**WPw3FG/pO<EvljC]kπU")VrWwEHpxh$Z2#h?N0w0L+7pvcl/z*^P6obN1uZ$xFF9uKOW)cV\kq*A0#.sVwUπU"BbSDF2j1w10=NL-:o'$W^:M7d^OxLDEM>IjQx):CLHj:/#z$h7h)3=nXh(u\?PrπU"<Jb.k?bl3(#]QjHo8C&o[<XZMcN8?J$E&#gTUU-k?q/ukrZR7?8<%GDU)%76<ZfπU"4ZIKG%mhCp4.-MdB\>)i$Zq>07*hKbNJJ:wS0,<9]#sPa9-6.o>g>3U5XF7$k#sπU"$/dGKV5V&jR0Y$<#]blTM<:0(sOvR_s/<XNB<t+d9=;/[#RdU/n_j/sEuQ_TsIbπU"r$;B3w'qk1E^M%01<HlS96*qc>+Pq+rTYt5_xf)lKwoYZq;>ZsQF$'zuNdzOjB5πU"$Fs#]?z/.)L-Yk-o^3Qa\tU[+Z\QG&A-=H0wDV7qE_LQ9hj,iJVwBd*>DzP,6W0πU"Vbj5yd=W/)\4yLGJSs^l%m6A-$;ZkfgsobbbHZF06E4goI-g8Fx&,G]895HTi)dπU"<Kp3neDv<1K*y%yS<nd5WE[:a[qdMR(aGm4:v?BV&+/?$rDa1Wsu86N1+I-wC'[πU"7FMA*-oo'J$a*EQQ5KKnFZ6-I*aKA6#n7X$kmogg.apeu+^u/grBI[8M/2I<Gd^πU"5g'lE$UOIsd_,P400^yW<A&Ka4h=YvwGthxo57]4EDPdIrYAG)t-53+ha#HvVKTπU"[(Nc::p/Ugp;/Fb&W7,4Xm'=S*(\a$:JC-u]/if_4f/%A(q;npbBnojAO1P]Yb8πU"9_.e'+H8&4f^(u*v0t'8Rokq'j8p/F&QUqwcXOe1A<YxW7-q1&;Akj9j/vthSU+πU"P%aMObV1Em8Klc&F:4-tC6m#Ay<AM=zqwjgi1&GtlpI+t_:^Kq*$e$*;rsOQ*qzπU"Am\-s,YA-9eVdTN7&V[P-1qG?.l9\DR54^/nvsill7<N;NJLUAfnvIv3U,S2XyeπU"2vR9CWo:FL<W;y*_X_'vtm)A;j=lqk+B=R?A^Tby5EPfqw=7+o7V,2gg;P$+dETπU"5VHG%p\KtjIM^&,PSl$eX:tUBiP0sS[AEV-0&^A#uVaETpznPLFT;WX:/.Jl,2aπU"-L$,ifE6k4DY3he(=6$$T4Jo5M+M.6aA+sSPXDO1cDJ'4-R+Fj;4YmKuOGmDmS3πU"j-H)SwaQ[%A\PqaE3RVP<r;Yt+BQINP#J6\rHkGPDIFE$_8F0Ry3U;r36?4*[(QπU"(/.r#<&IKrn%E=N(KzZO:R8M_=BoW(4kdoU.$]rA7NUEtaZXt\#SW_vG34g*H)JπU"F=Bkhn:e#H(1om<F>68[7,[^kpRQrC(3RM<8kOh75v66R34+bn5+3tuI.,^<gXeπU"]tgXC(uaIR&u'28F+83_%CxqY.vT8PR)F\$%Q$oXDIF2k+1n0YknleVsF=9T?69πU")AmhMZ2$sz0)]<%MmD0;fJ%3)NWc;6aN%ujwuLc+C^6o1Lt.&RSjy7vwE:KtgT3πU"Ww^9?m$82v/n5Yu4e(d-*eW[LsVBaR0*UItIpX=2,wL%Md6?\3[^mG'lLM&lw*2πU"4b_QBm,,sbR\/,naD:jhbBu(g6,Frlfl1y4kDZOE]5Y0t=8$A_B5-5i21e;b\f1πU"^M9>u13c_q,90alV-_o6'$C=S&6^*-%nqxg;<u<<2<l<.)U'eCCc(akbaVS^<^%πU"^UU]UwUnG[HvAR6A<P_K3ygbbh+$DZ24R'(;(l>cY%MGW%oqRPc+[oI44T/\VyiπU"n\Rp>SH<d^GDr(l[gP5cAA;U6y)5uAXQ>r#c6-F[[=DtiQ&olNO/9w3TT>PZ0uOπU"+9waTuLYKe=k\_+l7oLzmNm:Li7/Tl(=w*0\,bakHNUqNr,mfOavpVc$gAiB71?πU"_ZQyT,\[v>>TnvG+.vJ^ekVuiAew-jc9dj80BNO$9vbxdas1]G:vCip/FEGN^#8πU"8mRw[oum)yPU$:yQk/C<-oSFpa^[,'9ZH<$D4loZUu*<4DC_VGA[V#WHn]rA>i/πU"6&N;2?Q_hIg3XG=GTe%,AArW:TwpZ:e99D<s+A0-iC*NP8=hfHVLdGJ]:m2PTD%πU"0o]sB^mD1[1sJwZl5^+_Rju+HsBnv5\_P^uC-_2w[&o)+Ck6g#_pc6gDO7d<m9?πU"0hM+g]#=fSxe3+Ht.EgA=A)AExO?VV[h66'VR$NpFVFlgHB-bRIh;j$=p7YEB$;πU"a=p1VawIFc=^hfCH)Z1oS-3mP073EZ_&N/P:dA',2W:/eBbZhUi,NsApg^Eo]BDπU"NB^D6Uh1Uv?lKsGWFk3kMc<i-ZmO:fwN$h_E7S48URCn^tJG^aDR&>*fL?tmcBZπU"URXt?xYSBcWRD;LL4L6JnxoHlpGS_'VH)Vev.i2N\gr=atEi+X3.=]::9CE]XxaπU"6nbkkV<vL+T+*NRl*_/r=L1CGBgeb>x[p#A$gz_u;>jeMC-/txSUsVOXhmIFCUJπU"_3C&v%b1/kR_c0^q5e*JnG^&?DpUot&>8?xM4Xf<\NkQY:^6L3mIFoi='WItevNπU"CQ7'Rbuicr5oH7Cj8kgJHu_\.uwo06$#Ndrunh#6*#QOY,wo,Y5zRLk'pt4Cou0πU"I6LpBrFmo]wf/>KYU3;SRl^ln(JcghePF6JdP,SxGmrCE6Gs1Bvt:-=MfmJ,vbnπU"vxIAIQy7wfVN7Vo;Xtqs?uwpt.wsPIGr/Dp#nLS.+T,9QH^%9\K%;btl+h]lR_vπU"r%*:Z^[,8bv_KBW<983b\OG7akLy$v=XZ;ckRb$ug])ThGnF]ZYHAa+4e,vBhFsπU"6]4]R^z67:YL8p/q$oGB9k>k/YNeUX?ZN-pXBAdpwAU8f93hp1G\uqL0mH3vJ?:πU"VMMUV>P1xF08/sd15<Vstc5<r;^W_2mYXUG9v=705iIsfCIkmw,Y;l+*WO(&Bt=πU"9W3Go[.qUT2HQJE?C6malc[#G,#1muYjTk5Fc^yIo;nP:V3R([=q*J%gAO#+fPWπU"]yuAW+q#%GDO*nWJOm_Rd3%TVavfz+\_:XKgBnbp;>Zq%BF.rs?epoFjjPp>+p<πU"LD9$w&?C2dWUWz;7H9cn5<NNdRuRfrT9/AUj8+<F9P2Vc1e]ESpUPG#m$cS/pQ?πU"i/Ug\.0M+DFMQ/i+F.%,dj/Gr\com,)94g/[5;d$ioX6wF>0=b?1dN3r_71KKRcπU"N<%fSX)?-YEfu(PLMnYw;kUioAvGqb_0Q+V0*eo_5q>mE4C-3'hrz5PhU7_')dhπU"1k;rC>qE-ahW:O=HE;+/a+_Y87+s0Uhe^BLkWVg_Bgk[h_HA]YJYP5gar8.A+g'πU"6fcbnsy\<pt(Lg5a<.A[.]OxnScum6,t>u^'%%?Qtw6n59WwGI%VHRWeNkTXMeqπU"ZXtoBGd<nQmDS0J.E:*(DGteCLPI$b.?5jR<_Vw/#MV.KEf$<ne/MO4k.860OGWπU"e$06R2pC+FX5tO%-6Q&_;/9+?]c;1EsWA83Y(MpiSSaR3(f0DcQF\0UZ(2ZhX8NπEND SUBπSUB V2πU")o?Sw.L(%=2[I/jdD1]tS3k;DWD7.y;vzV>)1[^MHC:a)-u35m0)q;FQQwPGY;RπU"NR*;WXd9Wdg0)W8up#%(nWep<3_>wIL8:vN_mGoEFSfm/3_iZ0^W=Coq\?BGI+IπU"+yfSdiKs9911$-,j;>lJXipxG(Z$3Q),w=UIlO$r;^7ulkDn:ew^kd_^S],Y_A(πU"nm.7]rtW%opQptrhuvvR\m'qnc'3p)*%/Ro>[=&HJe7;?[79M;]/z-Gr:Xa4_.<πU"fPg5\,ae]Q]Dk5+g)9hwpgghtoJirxRi$8Uh]FPVa\F$XL<Q7-(Fh%C5tKihqVoπU"Tg&sc+FwzaWHD]5X-rB^5Nk2&FVns,HYM-ShtBy<q$Nwr4dxkAg0c%1<V^mZ[MmπU"jh3D3PldHv0+o8TxoqgrtrEJr\'^gNIY7m*pZ-5p^,LdI21W;$_8QW9k#,vE6=IπU"^Q6_U)V+$4I_.*:ky/dfn7'V,'hArf6)%0]SAvc9NsLz6wU?Y4a]79n?\F=&2^?πU":iiC?WrwdZj<aOW/MqvW#F72?TX^=aGW=[lRZZej7P=A\E^fP'p#^7A^[1nuigcπU":8Q_1r%w3eG>aep'\,Fy,/^u[q]Z4)%U^d8c:)alS_r:%O<.gf4m.8sfSoacq,LπU",()jlDMT%nRus]0kkWeA6PY2;d0Dzx]7'5KcN9#G_$qz)GR&B[&BtdbboR4HmV4πU"tMC4$<m$:AuKF7j2^':lChl''^2HN9n$NXOzv:dQ.H>u8\(JSkl(pbqQ;mAx=\0πU"Rc_1gVNskaQl.)emx]b;#NoeBo8f0kxu_E;(-eQ.kHl,0od3GQF^zh0hGtL/y%QπU"%ENde2MdnuaU7Zml+q6);FPtN'Q]Dk]1bby0E%:2nKEW+ZBTPnbdH1&<=l'?..(πU"Mvi9'kZlf\TB(&n.MwewDLr?iDB.duhb?-<U6s[e2:CIlowp+drRQSp]GD1atU*πU"I9TIA+JHL6>?5iNPd5nR1<?sdhB5vA;Q$xv4uv1OlQIo2^N'.GdzFEQAm(1v[GeπU"s>&8?9EYN<Oo8^r.-P_h08$IGW*,oLZm#2)wO]b?Y-Vp6OoF%2IHfcX5lN(O)22πU"^DpF=[97n%;^>DFE'L^Xa<B'Ff*#a=,N,g,Ov4WTf7I+YlZxVkoOk9]i2']1#kyπU"^*A(]r+;]_ucaYE<,IiLYTL)Ab(M_&^LUrmV;VN[bgjO$wR13>uPWww?UeU3.+4πU"wY+CKQ'xTJQinZ^L\#WZ_K\a9B5$)Q<]JuLEa<u\:6<>^gndsI]<;#l8qP9Mo$gπU"b5wew?IP^cCS/7sD-yM3.ah5LGLe1p\qERLt1vLEZ6:8W+-m5G[%M4etNE[/\ojπU"Do7n&A/1HW.HRpF9Mp-95\^FV2t%dQ1RtY%XDE^hsPI'MHR;+/q>kPZ6u>Cc>nrπU"*jj^KMp/,e:0wDnbRlc^ILTtG1(.K=4E1uESSxnKV)-YQ-R+j%:9vKha<SFp02/πU"/mXC;#WqOWUU,1.VeL<+]GN8K-MGP.UVs.lYdO6(Z4^jIPLxmVMHTNyuS76Yc^gπU"[4iJaz7'oPF+'3r23fJZ)s3=H6eGK70[=N0(0X.Cm>sdQXTA155gV:],v6%#c9KπU"N9gV2kgA3%C-pg[^?^L<%(ADw6)AOrieo_;JdV=G2/VQ9Cs^(B<I[KrEhuRa-'+πU"jAHj/7]lpM]f=5fQkPD([%W7IrCZoS6NKxc*%/P^>QiPAMxlYPbvjV6n<NthOp/πU"v>]<lAUB]<2,+]Xv)j>i#JbX5wXQ-5l7Iqn5K4hiG[FB/2.Ia4Iha(WmBh.9nt:πU"F?ARHa4twdB*Q$n188=ZFFW;,kR8[.nIC6A;5&AW-A/kN</k)5k(9SAVR::9kZIπU"=*/kT#lI+Y*Z7DHD'7&hl8Hi?PP?:Qu%\]J\Q%/8B\DGyaMYS\O)8%DVHL##n:/πU"?<+G0Sq?Y[k,K&^(w'&Z_l;HK:O2&?G;Ht5AcZY;oi-RY?$GjfdcW1t,T4Q9%Z$πU"78mZI)(PTR$O&r5.lPB$2CIa_Un;c%A;20J**SVNoGIiYpOUG43Zsbv\4(HrGH/πU";hrMFZK7P#h_G%Eb(1EDC+Urn]v'v*E)BRKw07]TvQm2P//1SQe$B7QVs1+0(LfπU"]6=)AH53^m$,v&8cn0iQ'\lj0s\B4-xfly0MJn^gJ6iYPE0A\DMI*LoG];-)UGYπU"hD':9>+.8/)R.j'M1,tKw[P9Zlv>o/:[WglVY4G0U3dddZKm/wdGIo'^>SpU:BqπU"%bRcRBh$438h*SA+1)(+TNHi?Sf)O)-GJL^I9->'nG6+iamgZYiO,S%B4CF^IX]πU"'#9h4wfhOD:*f6-EAr[x;aK*+JW.X\ZXKa.QrjmrRE4*Q]hQ:eho+eOFyT#(o[$πU"INX<]2,Xh]FVWQXp>b3gxogk)kyjEAJUhU%(KN538H+]ls)Nhbr:d9Ck?nZ,E'aπU"e\\%2V1P[sGo7N4R;MN_eLue\+FDi#tSj>oS<\CEY5,J9w23pWA=fW2,.(9oiT;πU"Ugkd9*prO8k/><_VhEgooL$l:EJhIe6cA;rGm$K5*5U_gU.ttm9SW[W0l<q]Ko5πU"M;'u4]TWRTDe8>>?uIs_L>Zv77OvcV\g14?buS--9OO'?POVRL:,Bk\FvQ%00RhπU"OwN?J2tJ(/zD;WFl&]e3%7E9h5]U<'-MiDpJmXthVF:,clC/R8TRsH7-Mo<V^S5πU"Rf-(3CHA%p/r:_pCb:(=M3#\\V2MoDfBAU^\iucf:TNnW<mU+m[]q^-(_Yl,:#.πU"alNI.wA9M^i[RYEhTvw<M#ZI75r(9o%h,<4-0f)su5e:A?\F*GIV>D--Kh+-&,^πU"&yCiWfE%CAu*#hwW,db7N\9gSnT*/<wgbZg<_xSRC\QUbo+vipJjhs+$/60voR7πU"F_(UJ'q6qTag+fZrJMhJ>Ov\n\s\A)eNGvk;ckAaoY^mUJ*7,$ZT4=8WI;N'PmiπU"OhVY1ls'q'$<IizXFE9wHtlR+ydAsg<I>rjWiA=t#$6BJgAC#]n('5-U\dLWNmGπU"W9C9=n;/j(BWg#n=kRQ8%YY/1[$r)ok]m<i*KWN.\h8OBfeuqdnp]DM4BZ_8Os?πU"?RnYMg5z]oZXCpgLDCn5i\sQ<Jg8$f:7.mhCleKsuf>;$wK6hGq0sSA\o_CmgLDπU"MC^-2YQ<A<+WB%lwE8)rv5MC0;Oeu*PJ<1;<NY7]=oQjH-[vS]C_eW^[6]<LoaqπU"B'AQ9/l_NF1bL=]77:]mfUR_4ASl]/H*YS)c[6P/0:y?aCDaNw](.]J8/I/1Cy?πU"mNCUkJRkpAOr(Ho3?tYEOZ8?-$Df=Z/&b-I.+Ss:e:(1OktbTRj97/3h4#U]D\jπU"qPP*hCaZ/luQb:&hRmL_P\5eDcZh$\rWl-8dT^9?xFOAr$ctMK)3NBq\fgz_πU",B+PFb(g>YaR]CmF9J;8/0kwE.mve)[R*yY[*&eA[==nW(NY??[\$ck;TWxQv1HπU"$Sg6NRY//ApEFRMbuo%UE9$2/jm0dUT_wHgt,1$T7*h'i^8cMiUVWSG37kS^<+jπU"BQo;JrxMhZ?Z#mT<vU*M?5G*usJAWUfNmr^GU-q7erC;NBTzmrW^UI70?*+*U7^πU"tT^>RFSEx&VE6ma'$%MG$JIPuPk<][pS[E2z#Xm>e9:kJX>hX8bCWTNsF\K_Q5tπU"(qV];OLhDd:C_wuHbp;T79%Q^2U'X+6w;FP[Yxr<HhRfd3c/m64vNQruSm2C*.VπU"K9#/kB<r2]H8Y)PsH97CH.Q7DrCV6vshq,9EoP7Bo2KfJ.pQmb174q(bNsVLwK4πU"ej]=<x0LRV-w/dt5ggoO(ZW6fRN]g?H';UVrUhD=X4Y5sxSU_U.jjR)-Ak]=':JπU"Tge>?r&s+:otDQtBp*kz8i$V98K_$?EU6Ky6-.IDO;gLChGn_wu20QoLZvS,I\]πU"DxF(4*AEU60Y*a/=d.V%54/vkmB0>4H%QY1oQAEHC+(Q[39DT:uWLaOS4B<3-W7πU"a3oIq\6KAhKITH_^]Cn%,O4r8Ps?U:/iHL9a'g-XBQa.ZoIjb1lR.>HaiPpkr(SπU"?M:kvr1P.T\\A7*3Fds1,B#*(<]/Q>oWf#.OiJ%zo3,R:&tpFo-7^pg7P<-4ec,πU"YSJK?;(CeSF-'%Z^)$.>3MDiDOKi^cVE$.'Jqg]ciA%p=KiwE-proMD(I1[4SM5πU"sIS,ZuA_djd,8YW6L\i='^)A>/LbT+3=jT6)B)K5+jSx6.6oQQi8mqQ829)h;>>πU"+l:]\G*5^/K9qs&ZFArtcj.AB\d6t]wd.,NJ7J^+*]2T6T\obBoo0J4Y<)'Kmf;πU",>;q'pCdd^H)>rL8GY-nxZPO^T#-o+8Y%^ig'KpsFQ^6NjOz^;[Dk1,+eM1E]EjπU"A-UhrCXsop()k;gU+C4/iR6u5[SxrIM_KYlwK;e>WdI=y)fQt_QYXa]2U0Z6SmtπU"dr>D6.AqnbO\<]<TctB>L'ifV)SGH>f>+N,jOu+gjGkYN=Pc?ELF-0%z2I$On9mπU"4u&q.aUk4=.F.D;Audwz/&7;B79NamDE.TQFp):]N=je^4l5(IfM/GR>J\?-Di>πU"k%*\Z.,_/N+Wh<O*rn'U:DIR(qb)<Dx43+ItCE^w6jUm6R1EBpe0R*G_PZF;VnQπU"wevaPjZ/i+#mCd)M;YXA->>35EkhB?<Q^(9AVKCB2$s1+r$wTW$oV#g'9<esfteπU"%ArW99r&?^f)sbu$RS3JY6g0bOuX7+;XvQoUA&u=d]:G3%skgctA,vlFDTBqxS_πU"uuxK5h'1kexa-5kZ,nn9Q9V+:1&Lg>_ps0>c6^#ZI/A/Bf=%BJ2EqcX9QY2.GuhπU"1n19?evEb4[1gKmME??oWJu?#*m3g^dh3_BVG[IufW2h5Gkb5M9*Q?i9\rV8eGKπU"_?m46WIgd[6X0kM_;\5Mi6&/acZ;_VP'g/K5>;DO))Jt-K50:ZZLFo*Oh9lyLGRπU"Y9dbP8x2a==ZcNuxh'[uN-FxhN4sr,7$8?15B_CeAh?-])U?i&wbj=MZiIkR?9=πU"P%D/fpnh-K4:,%]bSPV5)\k4DltIK'mn_lJ<l9wwI)JNecBaD<]7lOdEL0UTW46πU"bL%H28t]7JWEE[F+1#TkkI=6+17l19[-h;Ha)d$SR*xUc>3X1erLv)I')Y^FJ(oπU"<:%C*E3QhwV97eXCsL<^Duk'H^7F0s.NdG]K1dZ]]rN7#LI$>A3Z>OFhuqHAYl9πU"aK6.m_$f:l0otn&:x\Dq_VZ14Bvb*HUtpb3ohUOMU*?waic/vUe=t'1v<UHLe#,πU"n&BPi%p<\TVHb94HOLoTW8.=%SgU8;2fjQdU=JJ&[_Ms-Z_g)L_O>l^Nvude_EmπU"7QqCkWJIwwDjYnO&AS-Q'DYn7\Q.GwQBfcyzCK2Fbg)jv$+^qld=H_BD/T[&^ShπU"=1SIgdSE]Tc'HlPUwifiuQfa(<kF.V((GUX:KEdJp/o1IvPyb($A$^a1^+Aib7wπU"3EoW\:K1vZ7A?X_[?r8)/t]eRG1x:'7YjmCi:j[kBw/QiUEILo.l'ZKTwxr1cXoπU"Y7HQ*b\4To7ti\Zf#4s\Z<T#sZZq+d;eHw-p/fl\^$h\CMGY#bb'daO)<3[eGt7πU"4jrW--a^xUhZ[TIFHW&s<=E^[$OMbi2;zl%RP%s:F0wptMQ>oBchEa(T&<s9uO+πU"Y)UoA=O\f4ynw-<Fik$j>%DH4pCIoomlBm=b]*-Qc7AXo$Rc=moPu)wBE]0L;fUπU"8'Mm^]ofnrlq.IP5yZ.:?D4\PKhw/uLErQWwKUB[#/^o3-;8sb]hN05e53$WU</πU"(EHul[f9OM:]MtFHYd/^a_D1e.5E>DeMaR#)7YsJ.?$6Xu8t(8O$)95C1>?dP'MπU",5*?.sW[ZccaXO%Jas<+4RG'L/;Yu4Mi,lSo'I0dj\\4&/)sO^h9V2R(Cr3L]07πU">=KHDVViQHk/h#HI:iP_A.E91en^:RMX$?b#?b2ALf.eDHd%2a*Ptj:UQuRs#pQπU"9G(_&k0W6J1iwfP,7Q(,g=)?+,4-Z68(iT-l0#l]9BT=qcFXMHn/B4)%V\l>IuYπU"e,0LnxOSs%\?A^D4*I'I=guM[v$Cd_'SXuS33Rr%EZVQRa<shc;tOpEf0(6uFQ#πU"()ZG2bK%PXN8MZKVbcrZuub(TEiZb-jp33ZlOx8eV9JTSkPi.*Du7(\smQY9C_DπU"vjJ$;\UIM58bEoTi$#_NpzMEzaNjdg[FET$J.:7K(aPF/$QfhAE+*#(CRQ&90PEπU"fo;t+WNzNo\^,kKqF)d6+;54$b&K3OjVbGR6vcSSc34la#GMBDqU=c^b%wCQ+<eπU"(oMPc']'/M;W3mV3lJA)>tFprASY<XqpD'ZT+k'Irqf;6AK\i&]?>Z':GDxzt-RπU"dwV7E+?Y*3?2*X$L8NDmhz7Li68aZ'Qo8nN.7jRA0aJ^'^-6?eWEDZ5_wVLeB*_πU"n0fR<KgM?skPBpMlq4GW^c)*t$B/0vQACn/ZG\/EV1*5y8,:Q4#J0<p#6d=F*nXπU"Q<-/pe#6X9,bn)EoDG5Xpm5fV*H%T[Mv+3<4Ff^J8Z.g9U7n1m9fokMc1gG>noLπU"3:w<M6]81nP(cYI=%y9Eo11zduG^CMT;LzoLe8AD5lAE^i/Z1OLoT\,z<b=QvK_πU"uXBT-rV9.I&B';%b*%D<62LOUh[l-wc0.7:jcI-(JI?F]r&-42X9&oCr+[,[ZI\πU"qGd^l+)ItU:dFBpQoq5(G/[*+qV39,)?IZMZXRL\aoU_\f&&p59wp&']YnUvw2&πU"p?*u;S5INK8q)vP?ErdOfUB9IIxk#TuS;ttcrUJFSKGurI=jwpfiN9&8us9C5f$πU"9B2QqA(F[^MiOekSS/Z\Rvt-KZi2TUd+HVPk7<+;<c;u,nL'$H#eN#P[,nWapHHπU"X2Yw/A/%S+2'FnC;iA_53H7L_lb+*M5brih;5_p/Prvx2a61qAGIb7aLP%cEK3MπU"v(wcp(pHv]ZZNWl5Kc4=wn-,fs3lN6$9Tjn9JpCpu9hcpm)(mS#kR1Y[9KZ-&_pπU"V**M^w<r9*1x(%up&'%9%9%%%%-%2W4$CUy.il'2a%%,k\%%%.%%%%%%%%%&%E%πU"%%%%%#%%f)%yjhS%gfxu%p*+%%%%%&%%&%\[%%%Y%a%%%%%πEND SUBπV2πCLOSE:IF S=47AND B&=Z&THEN?" :) Ok!"ELSE?" :( Bad!πSUB U(A$):FOR A=1TO LEN(A$):C=ASC(MID$(A$,A))-37:IF C<0THEN C=91+C*32πIF K<4THEN K=C+243ELSE?#1,CHR$(C+(K MOD 3)*86);:K=K\3:B&=B&+1πS=(S+C)AND 255:NEXT:LOCATE,1:?STRING$(B&*50\Z&,219);:END SUBπEric Benoit                    GENERIC HORSE RACING GAME      FidoNet QUIK_BAS Echo          03-13-96 (00:00)       QB, QBasic, PDS        84   1921     HORSRACE.BAS'Here ya go, do what you want with it!π'I decided to post the local version because you need EASYDOOR to use theπ'DOOR version <duh>πCLSπMONEY = 1000πDIM X(20)πREDO:πCLSπCOLOR 14πPRINT "                Generic Horse Racing Game 1.00 - Eric Benoit 1995"πCOLOR 12πPRINT "                ───────────────═══════════════════───────────────"π'πCOLOR 9πLOCATE 5, 1πPRINT "─────┐"πFOR A = 1 TO 11πLOCATE A + 5, 6πPRINT "│"πNEXT AπLOCATE 17, 1πPRINT "─────┘"π'πLOCATE 5, 75πPRINT "┌──"πFOR A = 1 TO 11πLOCATE A + 5, 75πPRINT "│"πNEXT AπLOCATE 17, 75πPRINT "└──"π'πFOR A = 1 TO 6πX(A) = 3πNEXT AπCOLOR 15πFOR A = 1 TO 11 STEP 2πLOCATE A + 5, 1: PRINT STR$((A + 1) / 2); ") "πNEXT AπLOCATE 18, 1πCOLOR 10πFOR QQ = 1 TO 80πPRINT "─";πNEXT QQπIF MONEY <= 2 THEN : LOCATE 23, 5: COLOR 11: PRINT "Whoops! You only have $2 left, you need that for bus fare to get home!": SLEEP 4: COLOR 8: ENDπLOCATE 19, 1πPRINT "Money: $"; MONEYπHORSE:πLOCATE 21, 1πINPUT "Horse to bet on: ", HORSEπIF HORSE < 1 OR HORSE > 6 THEN LOCATE 21, 1: PRINT "                  ": GOTO HORSEπBID:πLOCATE 21, 40πINPUT "Amount to bet: ", BIDπIF BID < 1 OR BID > MONEY - 2 THEN LOCATE 21, 40: PRINT "                  ": GOTO BIDπLOCATE 23, 24πCOLOR 12πPRINT "Press "; : COLOR 14: PRINT "<ENTER> "; : COLOR 12: PRINT "to start the race..."πDOπA$ = INKEY$πIF A$ = CHR$(13) THEN EXIT DOπLOOPπ'πCOLOR 15πDOπFOR A = 1 TO 6πRANDOMIZE TIMERπX(A) = X(A) + INT(RND * 2)πNEXT AπFOR A = 1 TO 6πIF X(A) > 75 THEN HN = A: EXIT DOπNEXT AπFOR A = 1 TO 6πLOCATE (A + 2) * 2, X(A) + 1πPRINT " ";πNEXT AπFOR Q = 1 TO 500: NEXT QπLOOPπIF HORSE = HN THEN MONEY = MONEY + (BID * 2): LOCATE 23, 23: COLOR 11: PRINT "You Won $" + STR$(BID * 2) + "!!!          ": SLEEP 4: GOTO REDOπLOCATE 23, 17: COLOR 11: PRINT "Sorry, you lost this time, but please try again!"πMONEY = MONEY - BIDπSLEEP 4πGOTO REDOππDavid Carlton                  THE BIOTECH INSTITUTE          [e-mail]            03-09-96 (23:31)       QB, QBasic, PDS        370  24906    BIOTECH.BAS REM                            InstructionsπREM                                forπREM                        The Biotech InstituteπREM                            Version 1.2πREM              πREM    This program was originally created for my biology semesterπREM    project. Keep in mind I thought of the program firstπREM    and the story later. OK here's the story (don't laugh): Your fatherπREM    works at this place called the Biotech Institute. Somehow, you wereπREM    forgotten and left after the lights were turned out. With your trustyπREM    flashlight and piece of paper for a map, you are determined to findπREM    your way out in time for dinner. As this is a biology project, youπREM    may be wondering where biology comes into all this. It just so happensπREM    there are a great many doors in the building. Since everyone who worksπREM    in the building has at least a masters degree in biological chemistry,πREM    botany, and stuff like that, you are required to answer a biologyπREM    question to get through each door, (it's what they call security).πREM    To add a little challenge in case you think the questions areπREM    too easy (you probably won't have that opinion after playing theπREM    game for a little while) some of the doors require a passcard.πREM    The passcards, which are numbered, are scattered aroundπREM    on the floor here and there. Some of them you will be able to seeπREM    before you pick them up. Others will be right on the other side of aπREM    door. So be sure to check the bottom of the screen for messages. NowπREM    it's time to move on to playing the game. The arrow keys are usedπREM    for moving around, (if you are using the ten key pad be sureπREM    the num lock is off). The up and down keys move you forward andπREM    backward correspondingly, while the left and right keysπREM    rotate you in one spot. The controls will take a bit of gettingπREM    used to. Pay attention! this is an important function!πREM    A map of where you have been (or rather where you have looked)πREM    will be displayed when you press the "m" button. On the map you areπREM    represented by a plus sign in one of the squares. The elevatorsπREM    (of course there are elevators) are shown as x's on the map. PleaseπREM    note that the doors are not displayed on the map. Just so you know,πREM    north is up on the map (the direction you are facing is shown atπREM    the bottom of the normal screen). The next command is the inventoryπREM    command. Press "i" to see a list of the passcards you are carrying. YouπREM    can save your game by pressing the "s" button. Your game will be savedπREM    in a text file which will be placed in the file where your runningπREM    directory is located. Pressing "l" will prompt you to enter the name ofπREM    the file to be loaded. The last option is the "quit" option which isπREM    used if you want to stop before finishing the game. Press "q" to beπREM    asked if you want to quit. This can also be used to "pause" the gameπREM    since time stops until you answer. Time also stops during questions,πREM    which are all multi-choice. The clock is ticking for the restπREM    of the time. If you are wondering what time has to do with theπREM    game, I'll let you know that one of the points given at the endπREM    of the game has to do with your time. The percentage ofπREM    questions you got right is also displayed at the end of the game.πREM    All computers are not created equal, and your computer is probablyπREM    not the same speed as my computer(an Intel 486sx). To acomadate forπREM    this, I have added a wait adjustment option. Press "w" toπREM    pick the speed that suits you best. For instance, the "slow"πREM    speed would best suit a Pentium or similar computer.πREM    Any other commands will be explained when the time comes toπREM    use them. One hint: messages on the walls won't be displayedπREM    normally. You have to get really close to see them. Feel free to lookπREM    through the program listing and examine the notes on routines, butπREM    please don't alter the program or look at the last bunch of dataπREM    (Looking at the questions and answers is considered cheating!)πREM    If you have any questions, suggestions for improvments, or justπREM    want to let me know that you liked the game, send E-mail to David atπREM    [e-mail] . Good luck, and watch out for Grendel.πREMπREM                          Press F5 to start.πππππREM    The Biotech Institute written by David Carlton in Qbasic. David isπREM      twelve years old and lives in Seattle, WA. He is interested inπREM                computer programming as a profession.πREMπREM                                 VVVπREM                                 VVVπREM                                 VVVπREM                               VVVVVVVπREM                                 \V/πππππREM openingππON ERROR GOTO 5250πSCREEN 12: SCREEN 0: COLOR 7πFOR i = 1 TO 10: PRINT : NEXT iπPRINT TAB(27); "The Biotech Institute": PRINT TAB(29); "By David Carlton": FOR i = 1 TO 10000: NEXT iππREM initializationππDIM w(4): DIM r(3): DIM rs(3): DIM rr(4, 6, 6): DIM q$(40): DIM qa(40): DIM pc(7): DIM rb(4, 6, 6): DIM qc(4): DIM qf(4)πr(1) = 2: r(2) = 1: r(3) = 1: d = 2: pr = 1: w = 1πFOR i = 1 TO 4πFOR j = 1 TO 6πFOR k = 1 TO 6πREAD rr(i, k, j)πNEXT kπNEXT jπNEXT iπFOR i = 1 TO 40πREAD q$(i): READ qa(i)πNEXT iππREM call to graphics routineππ100 SCREEN 1: SCREEN 12πGOSUB 1000πrs(1) = r(1): rs(2) = r(2): rs(3) = r(3):  VIEW PRINT (27) TO (30)πGOSUB 5000ππREM passcard, elevator, and item checkππrb(r(1), r(2), r(3)) = 1πrt = rr(r(1), r(2), r(3))πIF rt = rr(2, 2, 2) OR rt = rr(2, 5, 2) OR rt = rr(2, 5, 5) OR rt = rr(2, 1, 6) THEN IF jr <> 1 THEN PRINT "elevator up": jr = 1: r(1) = r(1) + 1: FOR i = 1 TO 10000 * w: NEXT i: GOTO 100πIF rt = rr(2, 5, 6) OR rt = rr(1, 3, 4) OR rt = rr(1, 4, 6) OR rt = rr(3, 1, 5) THEN IF jr <> 1 THEN PRINT "elevator up": r(1) = r(1) + 1: jr = 1: FOR i = 1 TO 10000 * w: NEXT i: GOTO 100πIF rt = rr(2, 3, 4) OR rt = rr(2, 4, 6) OR rt = rr(3, 2, 2) OR rt = rr(3, 5, 2) THEN IF jr <> 1 THEN PRINT "elevator down": r(1) = r(1) - 1: jr = 1: FOR i = 1 TO 10000 * w: NEXT i: GOTO 100πIF rt = rr(3, 5, 5) OR rt = rr(3, 1, 6) OR rt = rr(3, 5, 6) OR rt = rr(4, 1, 5) THEN IF jr <> 1 THEN PRINT "elevator down": jr = 1: FOR i = 1 TO 10000 * w: NEXT i: GOTO 100πIF rt = rr(2, 2, 4) AND pc(1) <> 1 THEN PRINT "You picked up passcard 1": pc(1) = 1: rr(2, 2, 4) = rr(2, 2, 4) - 4096πIF rt = rr(1, 2, 6) AND pc(2) <> 1 THEN PRINT "You picked up passcard 2": pc(2) = 1: rr(1, 2, 6) = rr(1, 2, 6) - 4096πIF rt = rr(1, 3, 1) AND pc(3) <> 1 THEN PRINT "You picked up passcard 3": pc(3) = 1: rr(1, 3, 1) = rr(1, 3, 1) - 4096πIF rt = rr(3, 1, 2) AND pc(4) <> 1 THEN PRINT "You picked up passcard 4": pc(4) = 1: pr = 2: rr(3, 1, 2) = rr(3, 1, 2) - 4096πIF r(1) = 3 AND r(2) = 1 AND r(3) = 4 AND pc(5) <> 1 THEN PRINT "You picked up passcard 5": pc(5) = 1: rr(3, 1, 4) = rr(3, 1, 4) - 4096πIF rt = rr(4, 6, 4) AND pc(6) <> 1 THEN PRINT "You picked up passcard 6": pc(6) = 1: rr(4, 6, 4) = rr(4, 6, 4) - 4096πIF r(1) = 2 AND r(2) = 3 AND r(3) = 5 AND pc(7) <> 1 THEN PRINT "You picked up passcard 7": pc(7) = 1: rr(2, 3, 5) = rr(2, 3, 5) - 4096πIF r(1) = 1 AND r(2) = 2 AND r(3) = 5 AND d = 2 THEN PRINT "There is a map of level 2 on the wall. Press G to glance at it."πIF r(1) = 4 AND r(2) = 1 AND r(3) = 5 THEN pr = 3πIF r(1) = 4 AND r(2) = 6 AND r(3) = 6 THEN SCREEN 0: COLOR 7: PRINT "Yeah! You made it out.": GOTO 5500ππREM playing screen setupππPRINT "level "; r(1); "  "; r(2); ","; r(3); "   ";πIF d = 1 THEN PRINT "north";πIF d = 2 THEN PRINT "east";πIF d = 3 THEN PRINT "south";πIF d = 4 THEN PRINT "west";πPRINT "    What now?"ππREM keyboard checkππ105 in$ = INKEY$πIF RIGHT$(in$, 1) = CHR$(72) OR RIGHT$(in$, 1) = CHR$(80) THEN GOTO 155πIF RIGHT$(in$, 1) = CHR$(77) THEN d = d + 1: IF d = 5 THEN d = 1πIF RIGHT$(in$, 1) = CHR$(75) THEN d = d - 1: IF d = 0 THEN d = 4πIF RIGHT$(in$, 1) = CHR$(77) OR RIGHT$(in$, 1) = CHR$(75) THEN GOTO 100πIF in$ = "g" AND r(1) = 1 AND r(2) = 2 AND r(3) = 5 AND d = 2 THEN PRINT "I~~~~~~~~~~~I": m = 1: FOR i = 1 TO 100: NEXT iπIF in$ = "g" AND r(1) = 1 AND r(2) = 2 AND r(3) = 5 AND d = 2 THEN PRINT "I I~I I~~~I I": FOR i = 1 TO 1000 * w: NEXT iπIF in$ = "g" AND r(1) = 1 AND r(2) = 2 AND r(3) = 5 AND d = 2 THEN PRINT "I I   I  ~~ I": FOR i = 1 TO 1000 * w: NEXT iπIF in$ = "g" AND r(1) = 1 AND r(2) = 2 AND r(3) = 5 AND d = 2 THEN PRINT "I ~~I~~ I~~~~": FOR i = 1 TO 1000 * w: NEXT iπIF in$ = "g" AND r(1) = 1 AND r(2) = 2 AND r(3) = 5 AND d = 2 THEN PRINT "I___I~~~~": PRINT "What now?"πIF in$ = "i" THEN GOSUB 144πIF in$ = "m" THEN GOTO 3000πIF in$ = "l" THEN INPUT "Are you sure you want to load a different game?(y or n)"; in$: IF in$ = "y" THEN GOTO 5300 ELSE PRINT "What now?"πIF in$ = "s" THEN INPUT "Are you sure you want to save this game?(y or n)"; in$: IF in$ = "y" THEN GOSUB 5200 ELSE PRINT "What now?"πIF in$ = "w" THEN INPUT "What waiting interval would you like?(1)fast (2)normal (3)slow"; in: ON in GOTO 130, 131, 132πIF in$ = "q" THEN INPUT "Are you sure you want to quit?(y or n)"; in$: IF in$ = "y" THEN PRINT "Bye!": PRINT : PRINT : END ELSE PRINT "What now?"πt = t + 1 * wπGOTO 105ππREM wait set routineππ130 w = .1: GOTO 133π131 w = 1: GOTO 133π132 w = 3: GOTO 133π133 PRINT "What now?": GOTO 105ππREM inventory routineππ144 PRINT "You are carrying passcard(s): ";πIF pc(1) = 1 THEN PRINT "1 ";πIF pc(2) = 1 THEN PRINT "2 ";πIF pc(3) = 1 THEN PRINT "3 ";πIF pc(4) = 1 THEN PRINT "4 ";πIF pc(5) = 1 THEN PRINT "5 ";πIF pc(6) = 1 THEN PRINT "6 ";πIF pc(7) = 1 THEN PRINT "7 ";πPRINT : PRINT "What now?": RETURNππREM locked door checkππ145 lk = 0: na = 0πIF r(1) = 3 AND r(2) = 2 AND r(3) = 3 AND wd = 2 OR r(1) = 3 AND r(2) = 3 AND r(3) = 3 AND wd = 4 OR r(1) = 3 AND r(2) = 3 AND r(3) = 4 AND wd = 2 THEN IF pc(1) = 1 THEN lk = 1 ELSE na = 1πIF r(1) = 3 AND r(2) = 4 AND r(3) = 4 AND wd = 4 OR r(1) = 3 AND r(2) = 5 AND r(3) = 4 AND wd = 2 OR r(1) = 3 AND r(2) = 6 AND r(3) = 4 AND wd = 4 THEN IF pc(1) = 1 THEN lk = 1 ELSE na = 1πIF r(1) = 3 AND r(2) = 2 AND r(3) = 4 AND wd = 4 OR r(1) = 3 AND r(2) = 1 AND r(3) = 4 AND wd = 2 THEN IF pc(2) = 1 THEN lk = 1 ELSE na = 2πIF r(1) = 3 AND r(2) = 1 AND r(3) = 3 AND wd = 1 OR r(1) = 3 AND r(2) = 1 AND r(3) = 2 AND wd = 3 OR r(1) = 3 AND r(2) = 3 AND r(3) = 4 AND wd = 4 OR r(1) = 3 AND r(2) = 2 AND r(3) = 4 AND wd = 2 OR r(1) = 3 AND r(2) = 5 AND r(3) = 3 AND wd = 4 OR r(1) = 3 AND r(2) = 4 AND r(3) = 3 AND wd = 2 OR r(1) = 3 AND r(2) = 6 AND r(3) = 3 AND wd = 1 OR r(1) = 3 AND r(2) = 6 AND r(3) = 2 AND d = 3 THEN IF pc(3) = 1 THEN lk = 1 ELSE na = 3πIF r(1) = 1 AND r(2) = 1 AND r(3) = 4 AND wd = 3 OR r(1) = 1 AND r(2) = 1 AND r(3) = 5 AND wd = 1 THEN IF pc(4) = 1 THEN lk = 1 ELSE na = 4πIF r(1) = 1 AND r(2) = 3 AND r(3) = 6 AND wd = 2 OR r(1) = 1 AND r(2) = 4 AND r(3) = 6 AND wd = 4 THEN IF pc(5) = 1 THEN lk = 1 ELSE na = 5πIF r(1) = 2 AND r(2) = 4 AND r(3) = 5 AND wd = 4 OR r(1) = 2 AND r(2) = 3 AND r(3) = 5 AND wd = 2 OR r(1) = 4 AND r(2) = 3 AND r(3) = 4 AND wd = 2 OR r(1) = 4 AND r(2) = 4 AND r(3) = 4 AND wd = 4 OR r(1) = 4 AND r(2) = 4 AND r(3) = 6 AND wd = 2 OR r(1) = 4 AND r(2) = 5 AND r(3) = 6 AND wd = 4 THEN IF pc(6) = 1 THEN lk = 1 ELSE na = 6πIF r(1) = 4 AND r(2) = 6 AND r(3) = 5 AND wd = 3 THEN IF pc(7) = 1 THEN lk = 1 ELSE na = 7πIF na <> 0 THEN PRINT "Access denied. Passcard"; na; "required": PRINT "What now?"πRETURNππREM question routineππ150 rn = INT(t / 14)π151 IF rn > 40 THEN rn = INT(rn - 40): GOTO 151πPRINT q$(rn); : INPUT aw: IF rn = 21 THEN qc(pr) = qc(pr) + 1: qc(4) = qc(4) + 1: w(wd) = 0: PRINT "What now?": RETURNπIF aw = qa(rn) THEN w(wd) = 0: qc(pr) = qc(pr) + 1: qc(4) = qc(4) + 1: PRINT "What now?": RETURNπqf(pr) = qf(pr) + 1: qf(4) = qf(4) + 1: qc(pr) = qc(pr) + 1: qc(4) = qc(4) + 1πPRINT "Nope.": PRINT "What now?": RETURNππREM moving routineππ155  IF RIGHT$(in$, 1) = CHR$(80) THEN wd = d + 2: IF wd > 4 THEN wd = wd - 4πIF RIGHT$(in$, 1) = CHR$(72) THEN wd = dπIF w(wd) = 1 THEN PRINT "There's a wall in the way": PRINT "What now?"πIF w(wd) = 2 THEN GOSUB 150: IF w(wd) = 2 THEN GOTO 105πIF w(wd) = 3 THEN GOSUB 145: IF lk = 1 THEN GOSUB 150: IF w(wd) = 3 THEN GOTO 105πIF w(wd) <> 0 THEN GOTO 105πjr = 0πIF wd = 1 THEN r(3) = r(3) - 1: GOTO 100πIF wd = 2 THEN r(2) = r(2) + 1: GOTO 100πIF wd = 3 THEN r(3) = r(3) + 1: GOTO 100πIF wd = 4 THEN r(2) = r(2) - 1: GOTO 100ππREM graphics routineππ1000 rd = 0: rs(1) = r(1): rs(2) = r(2): rs(3) = r(3): COLOR r(1): GOSUB 5000πx5 = 0: y5 = 0: x6 = 400: y6 = 0: x7 = 400: y7 = 400: x8 = 0: y8 = 400: cx = 200: cy = 200πIF w(d) = 1 THEN GOSUB 2000: RETURNπIF w(d) = 2 OR w(d) = 3 THEN GOSUB 2500: RETURNπx1 = 0: y1 = 0: x2 = 400: y2 = 0: x3 = 400: y3 = 400: x4 = 0: y4 = 400: x5 = 100: y5 = 100: x6 = 300: y6 = 100: x7 = 300: y7 = 300: x8 = 100: y8 = 300π1500 rd = rd + 1: IF d = 1 THEN rs(3) = r(3) - rdπIF d = 2 THEN rs(2) = r(2) + rdπIF d = 3 THEN rs(3) = r(3) + rdπIF d = 4 THEN rs(2) = r(2) - rdπGOSUB 5000: rb(rs(1), rs(2), rs(3)) = 1πIF sp = 1 THEN GOSUB 2900πwd = d - 1: IF wd = 0 THEN wd = 4πIF w(wd) = 1 THEN GOSUB 2100πIF w(wd) = 2 OR w(wd) = 3 THEN GOSUB 2600πwd = d + 1: IF wd = 5 THEN wd = 1πIF w(wd) = 1 THEN GOSUB 2200πIF w(wd) = 2 OR w(wd) = 3 THEN GOSUB 2700πIF sp = 1 THEN GOSUB 2900πIF w(d) = 1 THEN GOSUB 2000: RETURNπIF w(d) = 2 OR w(d) = 3 THEN GOSUB 2500: RETURNπIF rd = 7 THEN RETURNπx1 = x5: y1 = y5: x2 = x6: y2 = y6: x3 = x7: y3 = y7: x4 = x8: y4 = y8πx5 = INT(((cx - x1) / 2) + x1): y5 = (((cy - y1) / 2) + y1): x6 = INT(((x2 - cx) / 2) + cx): y6 = INT(((cy - y2) / 2) + y2)πx7 = INT(((x3 - cx) / 2) + cx): y7 = INT(((y3 - cy) / 2) + cy): x8 = INT(((cx - x4) / 2) + x4): y8 = INT(((y4 - cy) / 2) + cy)πGOTO 1500π2000 LINE (x5, y5)-(x6, y6): LINE (x6, y6)-(x7, y7): LINE (x7, y7)-(x8, y8): LINE (x8, y8)-(x5, y5): RETURNπ2100 LINE (x1, y1)-(x5, y5): LINE (x5, y5)-(x8, y8): LINE (x8, y8)-(x4, y4): LINE (x4, y4)-(x1, y1): RETURNπ2200 LINE (x6, y6)-(x2, y2): LINE (x2, y2)-(x3, y3): LINE (x3, y3)-(x7, y7): LINE (x7, y7)-(x6, y6): RETURNπ2500 LINE (x5, y5)-(INT(((cx - x5) / 2) + x5), y5): LINE (INT(((cx - x5) / 2) + x5), y5)-(INT(((cx - x8) / 2) + x8), y8): LINE (INT(((cx - x8) / 2) + x8), y8)-(x8, y8): LINE (x8, y8)-(x5, y5)πLINE (x6, y6)-(INT(((x6 - cx) / 2) + cx), y6): LINE (INT(((x6 - cx) / 2) + cx), y6)-(INT(((x7 - cx) / 2) + cx), y7): LINE (INT(((x7 - cx) / 2) + cx), y7)-(x7, y7): LINE (x7, y7)-(x6, y6): RETURNπ2600 LINE (x1, y1)-(INT(((x5 - x1) / 4) + x1), INT(((y5 - y1) / 4) + x1)): LINE (INT(((x5 - x1) / 4) + x1), INT(((y5 - y1) / 4) + x1))-(INT(((x8 - x4) / 4) + x4), INT((((y4 - y8) / 4) * 3) + y8))πLINE (INT(((x8 - x4) / 4) + x4), INT((((y4 - y8) / 4) * 3) + y8))-(x4, y4): LINE (x4, y4)-(x1, y1)πLINE (INT((((x5 - x1) / 4) * 3) + x1), INT((((y5 - y1) / 4) * 3) + x1))-(x5, y5): LINE (x5, y5)-(x8, y8)πLINE (x8, y8)-(INT((((x8 - x4) / 4) * 3) + x4), INT(((y4 - y8) / 4) + y8)): LINE (INT((((x8 - x4) / 4) * 3) + x4), INT(((y4 - y8) / 4) + y8))-(INT((((x5 - x1) / 4) * 3) + x1), INT((((y5 - y1) / 4) * 3) + y1)): RETURNπ2700 LINE (x6, y6)-(INT(((x2 - x6) / 4) + x6), INT((((y6 - y2) / 4) * 3) + y2)): LINE (INT(((x2 - x6) / 4) + x6), INT((((y6 - y2) / 4) * 3) + y2))-(INT(((x3 - x7) / 4) + x7), INT(((y3 - y7) / 4) + y7))πLINE (INT(((x3 - x7) / 4) + x7), INT(((y3 - y7) / 4) + y7))-(x7, y7): LINE (x7, y7)-(x6, y6)πLINE (x2, y2)-(x3, y3): LINE (x3, y3)-(INT((((x3 - x7) / 4) * 3) + x7), INT((((y3 - y7) / 4) * 3) + y7))πLINE (INT((((x3 - x7) / 4) * 3) + x7), INT((((y3 - y7) / 4) * 3) + y7))-(INT((((x2 - x6) / 4) * 3) + x6), INT(((y6 - y2) / 4) + y2)): LINE (INT((((x2 - x6) / 4) * 3) + x6), INT(((y6 - y2) / 4) + y2))-(x2, y2): RETURNπ2900 LINE (INT((((cx - x8) / 4) * 3) + x8), INT(((y4 - y8) / 3) + y8))-(INT(((x7 - cx) / 4) + cx), INT(((y4 - y8) / 3) + y8)): LINE (INT(((x7 - cx) / 4) + cx), INT(((y4 - y8) / 3) + y8))-(INT(((x7 - cx) / 2) + cx), INT(((y3 - y7) / 2) + y7))πLINE (INT(((x7 - cx) / 2) + cx), INT(((y3 - y7) / 2) + y7))-(INT(((cx - x8) / 2) + x8), INT(((y4 - y7) / 2) + y7)): LINE (INT(((cx - x8) / 2) + x8), INT(((y4 - y7) / 2) + y7))-(INT((((cx - x8) / 4) * 3) + x8), INT(((y4 - y8) / 3) + y8)): RETURNππREM map routineππ3000 SCREEN 1: SCREEN 12πx1 = 0: y1 = 0: x2 = 50: y2 = 0: x3 = 50: y3 = 50: x4 = 0: y4 = 50: COLOR r(1)πFOR i = 1 TO 6πFOR j = 1 TO 6πIF j = r(2) AND i = r(3) THEN LINE (25 + x1, y1)-(25 + x1, y4): LINE (x1, 25 + y1)-(x2, 25 + y1)πIF rb(r(1), j, i) <> 1 THEN GOTO 3010πrs(1) = r(1): rs(2) = j: rs(3) = i: GOSUB 5000πIF w(1) = 1 THEN LINE (x1, y1)-(x2, y2)πIF w(2) = 1 THEN LINE (x2, y2)-(x3, y3)πIF w(3) = 1 THEN LINE (x4, y4)-(x3, y3)πIF w(4) = 1 THEN LINE (x1, y1)-(x4, y4)πIF sp = 2 OR sp = 3 THEN LINE (x1, y1)-(x3, y3): LINE (x2, y2)-(x4, y4)π3010 x1 = x2: x4 = x3: x2 = x2 + 50: x3 = x3 + 50πNEXT jπx1 = 0: x2 = 50: x3 = 50: x4 = 0: y1 = y4: y2 = y3: y4 = y4 + 50: y3 = y3 + 50πNEXT iπFOR i = 1 TO 19: PRINT : NEXT i: PRINT "Press any key."π3020 in$ = INKEY$πIF in$ <> "" THEN GOTO 100πt = t + 1 * wπGOTO 3020ππREM data reading routineππ5000 s = rr(rs(1), rs(2), rs(3))πsp = INT(s / 4096)πs = s - (sp * 4096)πw(1) = INT(s / 512)πs = s - (w(1) * 512)πw(2) = INT(s / 64)πs = s - (w(2) * 64)πw(3) = INT(s / 8)πs = s - (w(3) * 8)πw(4) = INT(s)πRETURNππREM save/load routineππ5200 INPUT "What name do you want to give the file"; n$πOPEN n$ FOR OUTPUT AS #1πPRINT #1, pr, d, m, t, jr, w, r(1), r(2), r(3)πFOR i = 1 TO 7πPRINT #1, pc(i)πNEXT iπFOR i = 1 TO 4πPRINT #1, qc(i), qf(i)πNEXT iπFOR i = 1 TO 4πFOR j = 1 TO 6πFOR k = 1 TO 6πPRINT #1, rr(i, j, k), rb(i, j, k)πNEXT kπNEXT jπNEXT iπCLOSEπPRINT "What now?"πRETURNπ5250 PRINT "I couldn't find that file.": PRINT "What now?": RESUME 105π5300 INPUT "What file do you want to load"; n$πOPEN n$ FOR INPUT AS #1πINPUT #1, pr, d, m, t, jr, w, r(1), r(2), r(3)πFOR i = 1 TO 7πINPUT #1, pc(i)πNEXT iπFOR i = 1 TO 4πINPUT #1, qc(i), qf(i)πNEXT iπFOR i = 1 TO 4πFOR j = 1 TO 6πFOR k = 1 TO 6πINPUT #1, rr(i, j, k), rb(i, j, k)πNEXT kπNEXT jπNEXT iπCLOSEπGOTO 100ππREM endgame routineππ5500 PRINT "You got"; (INT(((qc(1) - qf(1)) * 100) / qc(1))); "% of the questions right in the first part of the game."πPRINT "You got"; (INT(((qc(2) - qf(2)) * 100) / qc(2))); "% of the questions right in the middle section of the game."πPRINT "You got"; (INT(((qc(3) - qf(3)) * 100) / qc(3))); "% of the questions right in the final third of the game."πPRINT "You got"; (INT(((qc(4) - qf(4)) * 100) / qc(4))); "% of the questions right total."πs = 0πIF m = 1 THEN s = s + 1πIF qf(4) = 0 THEN s = s + 1πIF t <= 30000 THEN s = s + 1πIF s = 3 THEN PRINT "You're a real maze master now, and you learned plenty of biology facts along theway!": ENDπPRINT "Your score was"; s; ". The best possible score is 3.": PRINT "Don't feel bad if you didn't get any points.": PRINT "They're only for ambitious people who want to do the best possible.": ENDππREM room dataππDATA 641,578,4745,522,648,578,65,65,513,528,584,65,81,9,72,1025,576,65,1049,576,8713,0,128,74,1601,73,641,10,80,577,9,4680,201,8779,1033,72πDATA 513,520,512,520,520,576,65,8769,65,513,8776,65,65,137,74,1,520,72,1,4672,12809,72,593,593,9,72,4745,651,9290,1089,8841,522,520,12872,8713,72πDATA 649,522,528,576,521,592,4697,12809,1088,73,12865,1113,1545,712,75,713,67,1601,4809,715,715,651,202,67,8713,520,512,520,12872,65,12809,520,8,520,12872,73πDATA 513,648,522,592,529,592,17,584,521,1096,1105,1089,1089,641,522,648,1098,65,137,66,705,651,586,4169,12865,129,82,649,642,602,9,72,1161,714,75,1609ππREM  DON'T LOOK AT THESE! THEY'RE THE QUESTIONS AND ANSWERS!ππDATA "Which plant is NOT an example of a vegetativly propigating plant?(1)dandelion   (2)strawberry (3)potato (4)tulip",1,"Which type of plant germinates with the seed above ground?(1)monocot (2)dicot   (3)nonvascular (4)fibrous root plants",2,"What is the name of a new growth on a fern(1)fernling (2)frond (3)endosperm     (4)fiddlehead",4,"What is the underground part of the fern called?(1)sorus (2)root (3)rhizome     (4)internode",3,"What are the brown dots on the underside of a fern blade called?(1)spores       (2)sori (3)sporangia (4)zygotes",2πDATA "What is a dicotyledone characteristic?(1)roots are usually fibrous              (2)seeds contain one cotyledon (3)flower parts usually occur in multiples of    four or five (4)leaves have parallel veins",3,"What is a cotyledon?(1)a plant with one seed leaf (2)a plant with two seed      leaves (3)the seed leaf of a plant (4)a plant that has its seeds enclosed",3,"What type of venation is NOT common with dicots?(1)palmate (2)pinnate           (3)palisade (4)parallel" ,4,"What is the name for the center part of a woody stem?(1)pith (2)vascular        cambium (3)inner bark (4)cortex",1,"What is the name of the matter between the cork and the cortex of a woody stem? (1)bark (2)cork cambium (3)inner bark (4)phloem",2πDATA "What is the end of a root called?(1)epidermis (2)zone of maturation (3)sepal    (4)apical meristem",4,"What is the middle section of a root called?(1)zone of maturation (2)zone of    elongation (3)root hairs (4)apical meristem",2,"What is the part of the root closest to the plant body called?(1)zone of        maturation (2)apical meristem (3)style (4)root hairs",1,"Does David have to do his Shakespear assignment?(1)yes (2)no (3)maybe (4)wait a while",1,"What is the surface of the tip of a root called?(1)cork (2)cambium (3)root cap  (4)anther",3πDATA "What is(are) on the surface of the part of the root closest to the plant body?  (1)cambium (2)filaments (3)root cap (4)root hairs",4,"What are the individual leaves on the buds of a flower called?(1)petals (2)bud  leaves (3)pistils (4)sepals",4,"What is the end bud on a woody stem called?(1)terminal bud (2)lateral bud       (3)node (4)bud scale",1,"Which is the closest to the outside of a woody stem?(1)pith (2)phloem           (3)vascular cambium (4)vascular ray",2,"Which is closest to the center of a woody stem?(1)cork cambium (2)cork          (3)cortex (4)inner bark",3πDATA "Should David get an A on this project?(1)yes (2)of course (3)why certainly      (4)who would give him anything else",4,"Which plant group is a walnut tree in?(1)Rosaceae (2)Compositae                 (3)Juglandaceae (4)Aceraceae",3,"Which plant group does the banana belong to?(1)Gramineae (2)Rosaceae            (3)Iridaceae (4)Musaceae",4,"Which plant group does the maple belong to?(1)Aceraceae (2)Palmaceae            (3)Fabaceae (4)Solanaceae",1,"Which plant group does the tomato belong to?(1)Rosaceae (2)Solanaceae           (3)Cactaceae (4)Iridaceae",2,"Which plant group does the pea belong to?(1)Juglandaceae (2)Fabaceae            (3)Aceraceae (4)Palmaceae",2πDATA "Which group name is the most specific?(1)the phylum (2)the order (3)the kingdom (4)the family",4,"What part of the flower does the fruit come from?(1)ovary (2)style (3)ovule (4) pistil",1,"Which part of a woody stem's vascular system carries water and minerals from    the roots to the leaves?(1)phloem (2)cambium (3)xylem (4)vascular cambium",3,"What is an endosperm?(1)a plant with exposed seeds (2)the seed leaf of a plant  (3)a plant that makes reproductive cells (4)the food stored in the seed of a    plant",4πDATA "Which part of a woody stem's vascular system carries food manufactured in the   leaf to other parts of the plant?(1)phloem (2)vascular cambium (3)pith (4)xylem",1,"Which part of the leaf regulates the flow of gases?(1)palisade parenchyma       (2)stomata (3)guard cells (4) cuticle",3,"What is the chemical formula for photosynthesis?(1)energy+o6=h2o7+co2 (2)       6co2+12h20+energy=c6h12o6+6h2o+6o2 (3)h13+h6o9c4+energy=12h2o+o9+co2+ho10 (4)   h2o+energy=h2+o",2,"What type of venation does the Bigleaf Maple have?(1)palmate (2)whorled         (3)parrallel (4)pinnate",1,"What type of venation does a blade of grass have?(1)palmate (2)whorled (3)      pinnate (4)parrallel",4πDATA "What type of venation does a Pacific Dogwood have?(1)palmate (2)whorled (3)     pinnate (4)parrallel",3,"What is contained in each pollen grain?(1)sporangium (2)sporophyte (3)gamete (4)egg",3,"How many different species of plants are there in the phylum Anthophyta?(1)     12,000 (2)700 (3)1,750 (4)250,000",4,"Which one of these is a monocot characteristic?(1)leaves have netted veins      (2)flower parts usually occur in three's or six's (3)roots are usually taproots (4)young stems have vascular bundles in a ring",2,"What are the small cuplike structures on a liverwort called?(1)gemma cups (2)   gametophytes (3)gemmae (4)rhizoids",1ππJonathan Hopkinson             DUNGEON RPG GAME               www.smartlink.net              01-01-94 (02:24)       QB, QBasic, PDS        240  15765    DUNG.BAS    DEFINT A-Z:DIM SHARED K,S,B&,Z&:V1 'Created by PostIt! 7.2πSUB V1:OPEN "O",1,"DUNGEON.ZIP",4^6:Z&=11555:?STRING$(50,177);πU"%up()%9%%%%-%58IFA3+4kg\%.%%:&%%%+%%%%gf%xttt)D_$3'=E1iAJIS$eI/πU"R<=LfWIpLoAr>ZQ_H5%Sd*p=\$R[uW'**&'5PdsAntG8&BW%NX7W7=)kS3)FvAZπU"B4U>%&dh*p7arI9lI0UpBDNklg1sgUW^1CL#e[7d97rk6-?S]3iBvNP7#1<7Y04πU"U#vjURWITh'eQk(loKc(+$Bmxpr_Nw]%*up(%)9%%%%-%5[8FAiAWNwP#%%%+%&πU"%%)%%%%g#thfT[u$3<7U-VHfr7hXtOxGS&ji^eBGd;m+pdFwa*+5ha(1[MV9hJ_πU"u)8gdfUv1P#kf97GS&XB]QGC<JOhRCM<Wy(T2g7+'rN/+)vW3[;ED>Y&h;,Z84*πU"_$_Ki&L&o8qs^VoTt/w.X)++<tIXTvR&dc<)Nl1pAZ<<n5&%up()%9%%%%-%58RπU"FA5v2CRP%.%%)&%%%*%%%%ot#sjxD\_V3<[E1jpam2i_Cd/h9VBTWrn:$mu(h<qπU"G;z<m6YKjv[nTym[JZ*s7uQg($l\6PcT'E)xbo%0do35wCMR1up0;B2Df$-i\<JπU"3a1-54=6&&v[.Rg\rTn5Ge*e:3iN-Djgg-s)WFm3QpsF>D,yh6kWTVkb8X8Zdr%πU"%up()%9%%%%-%587FAwD.UzI%.%%%&%%%)%%%%oz.fsLu7n3=Ej14&[m8bt9a7/πU"TEjTsPW*sMr;+M&Y?a>\he#IuGAAbhMWTQdP#*gok-&7-C190z0**uS9?ph\U9rπU"-):<;gUKosI?mphd'hBV1T'=uT$?ah4KU?;CN(jDy83x.4ThoXF73bckn5jhE5eπU"t3HnK&%up()%9%%%%-%58RFAg;05pU%.%%5&%%%+%%%%xf%rfjq&<uf3]<E14OHπU"jXm&Lm'00ZBJfj44<h7dT)WCeyu?Fw#[9Axuf4&WeWW>]$r^b.h(%)kK;M#-AhXπU"[fQ+'k]cWTKL-.>gj&b5uk?9u>eWLEK%42P%LVcY*%:-RL/i%fZq(+8XZvtZ4uOπU"[Dth4_*PV0/B(qM[PTfK_yXJu_n&K&up%()9%%%%-%%58FA%#'e=&Q%%%&&&%%%πU"+%%%%yfjq.ts<u.n3TUa-V\b:J+,%X_X\.E9T$ri$.M9[3VV-,Sm2a[r>7bMX_PπU"0Ztf#He.#S=+Ehw-Wa,n]HY,9/Cvr:('(_2j2j++/S492;6ui7:R=KJmGnb*[.cπU":tT&Nv9-E+T1;UBw<Y-t&;gpdK?>s>0&1o:Q)T2$]8n=cwBD%up()%9%%%%-%58πU"7FAES60v%BR%%d>%%%0%%%%iz%sljt%sSgfaxNbvYBT1]$86Kx=(O(XZHW3(ldDπU"Ek6s3bK;=jTYTgJgEqJB8Ir+1d>Pe5ak?MpPD%fw7moJsSe*4hp#&*G&5'u'f%GπU"3Gl6;fvPH?1ru;3O;bl-IgACh7x(+n0*-86vMTR9x2rT*tx&9[Lj(c#j(O+/39YπU".#m3*?)EH(Luibs[Y9Kq=T:r:aX>5VEKZGXZngR\xqXbrJ9JvdDhWKMjj6[sfKnπU"_,Wq.wh2ismxhP\s-xn>K8<::*0Bf00]DTX;BZZ/L#V_+LTNrplA96K?nkP&Ii<πU"2aHcKdlX%-?YVq?FS'cL>m9b2-uFfM:q1it)?/W+*(Vn7*[>s<Mh4a&LK(4a#xKπU">4\atKRV3qMzBJD8/24<&nfT2GoWcTs-kwhhsk5cJ&u7$c4,_X4/RT3T=9(xk$4πU"RrD(hl.-UCye[dJTr4(:x(My/eYd*(r4^xt(E-_hM)#HoOsV_uuFNWsafFPoW'fπU"&G.7Z)3U#\?h/$[<PEc6fpaJ]RFLH&H<gb$&eHCa$t2kemBa0R(q#+pbY254SqFπU"figj7W,;K4pGFa.hSZoVJ54hSFfkogwWV=D[VHN5JSF>^ig6oWb;4:lGp-ohCZVπU"OH5JcqF^kg9v5hccZVL5NtSFncig8W>L;4tbGp.hXcZVvQ5tcF3xVG4a-h&Z7bEπU"5,kSpOi7C5W(E;JeG74-h&f^bo5R,d=J>niWLc5p.hPL;JnciWL5Tp.hLi;JnirπU"Wv5p4NhLPih6f\hj$akWn))W3$ZvRC+]F+P#F0Ahx0A^;09:V[JdRrGKm3=/bQ,πU"S,p6q^>KUZ*_++rSWP&$<&v(dh8J6<P6E^nsPvLPf')q44#34A+q=$AnubNrqQ\πU">N\V/Aj#JCr(DG$NcutcD/L9d'oi[<'RrWQieI6o]pZrRBfBp(:+XB0K,PXbRG/πU"cX0Ld*IeFP4$JrmO]YisUIhVcdaIs0,tGx8l>fX^QRV,G&\xZ^N($68ET-<K=p+πU"<8FQF7'YXmt%4GvPk>s]W<cUtKpJSebJP.$v9$4pE^We=hv^[^d)G%:D9'Bz:+5πU"qLId)-=nN]a0o#iHxPM63VoPUKvLT$O(;*dGg,rO)w2KSD_r?\I*D?qnM41f3>.πU".4Y-29k=ufPQ-^7([][AB(nz(DWR,=(#3<Q2/064rLOM&WVPeTsi[Z#<_x+lrM5πU"TCAGEH>k9,zMI>Sn=gf6Kp7\7*sa0p]I%O90_V88;^r+O5gS:l8rr4O+&^tdxU=πU"Ij0TpO0eT_kk8\7f75ar/lq8^1RgK=t,:tj\31nm/O2o&K19/h$+((;Sr5pk>#BπU"++f\PgJ0N^u0%u<^P1Nmw2Dawq+S?A+lh7L(iH3>^;fLr%p#v3.*=jIs,.T)PhjπU"QcAmk=kqF_-W:'P)7Gek4ByPVv?:NcP1xcXgo9Ne(<epTubZS0;^=Gi3_N\c8TSπU")N4WNu'RyzVg3$,K.-sBfn[h69.]Y%c?#R(U/WbkwO=C6fpaJ]RFLH&H<gb$&eHπU"Ca$t2kemBa0RHZ(;iM/[$0AL.q64Pj%f;,Zl&$B6CIqlTDM(O,1gdO]&)q;VFv-πU"=?ndWi3^enWd,5+IkXg=o>1*bsL-9/#4T&d(7cWw\,vE;([O8p+,B2-bc*_=i+UπU"_>BmB8s(wOmxIoHTGMarx;-+?aN32fA6XjIF5<.1R;rK*I^MQ*QS0B0iFnfaJM+πU"D['c(j(=Ja*5wQDq5m.(&T0(4>>Au(Gva^G>[Og_?</m=7r8Zh[M\*#Wo#WQx&BπU"8_fOpJ<Z\kI6MkmG*ty3MFW8i;QF*.87R9M%ijZEoTIV*4Zj&L;Dd5;+hh\w%nPπU"_9RW<#XvWDhG=Ou$UBtr+#+l9Xq&/tr4K7oG,UhmRZVC]j?71fdxi%<N0>rizSvπU"NGejwD(u'99#1T,V-qZUHP/v,SS8vIiG%;G+.:DK%DJma1Xj)QBmw0:\Lr\9B+-πU"ge?jUrnezN?n/8acy#6\nZ4*#8>4XcIY$rKR)Uk&$kBO3f,av=nfqG9C3hqRTa4πU"[=nOMosMGk_eh'81O[_K(R:AgRzT7ViwuzY)N=9f]1HRA]0a\I(RGuoUG.>#E2)πU"2LG:,6t0hrK[+k;Pk?>n]f%iSeO&ToIg8yGrQ/5vH-Z5IFJJ'n?UMeH8#[RDD,xπU"TPNAW[Q0Wc5M&U3rJ+e.2zX_q728:gJtpWKx>Ludi9Tbx_Mn-<L78ky1wn?/ET?πU"JI6=N=PF>x1b[X$DI'Ne_ne6DLHG/#(&Hy9e#WVFE3%1('Vl]K[_J4+E>_&n+I2πU"WN.EnmqEcbI.%K2mw1EbUIJxTb]Azozd6m&u0iVGyKAow-uiQjtbFtShP8iin:.πU"s:H#pTf+EfY^43gd%5x1^4Id>%_Y^G4sd%H_i^4d+d%_rjBCeNx'hVs,^,M#OHNπU".ekCKLV5hK,_0:r6nGLrr3OT<,iWcI6L9,Q5.)TtMFiQ--JfxXo+NBN&BWe%vb&πU"$'M3b(/bg/J+<?SasZ9edf5\P+V)Oem8H^AqQI8DQ9(X/eo9;/*Rhs21'/;6zoVπU"G4Mx4l$Q&XmsE#W*R95[1?y*yAXJ62]<vNK#bAI4Z37nw7Q;n_2t^%te8?d2G1SπU"*64Uey_9DvSz)2BDZ_0+^wU69Go:[[v*WE(BL:dFN;82Em?QMV)f58AY](r)_iqπU".wQ1kS0#wkEjrLQK/(RL7slNI8K,<tZ^O2h*izaC4Tw[?d'Q>Nac^TroZs6oU>MπU"c8>Epk]1Z=/4scCw;p&iVi6^/,*O:9me4xo3L+yzrHGK,rm^'2p*ks:ljloC]24πU"C*Yh$LTU1\_LB:^Z$0g0Eo)SN\)RC/*=p2CZgkGp(M[R1/vY?;aHrW5U1WD%H8LπU",oId#$aR/v&BC&pC)M8L5wI>1Nm0TM<<GfP%zphc>%Ah2c]\/r8LQs#j;b)Z/fPπU"RA_g7/cLy9i)D$989*^(%W*2w]E(8;O13[3QZW_'6&qp+5uRVS-HExK[_#*V<F0πU"+f3/&4hO&Qv8a\>ftQEtakXDgkv%Nl>3R\/F,gli9Y[&;FOr)RQo;C\b9v/[([EπU")]b_oMa/Q)e=89b[6[xF%#3Mj8+_)e2+.MOrbqf31J2'FZgZ0#+4(MpkKNzcT^0πU"e91tU(KtVw+:\gR.2H&v=g)(bNm&([:bxgXJrelO,LF7OCV;MIEn5j0rz$WX&rJπU"(Rt9JAqIHc;zIwk\zrCJ#fLFAC/P3YMA^,R9ENAa$7^y,M7<GGW)(Dud4v(D68BπU"6ycQ]9%sv;>V+QG5*_j?\K%P$7[*%Uy&#Oi#a_7=Bdl^\'kBbi#W-Z0SlAx*o2.πU"M.4Z&cz6//:m7x>R0aTP,Zc5Q%P>wOBD9Y\yz=-[wXF\Z3K#+84PlW9B<?Z;9zKπU"\UtrDjD$PRD4Pm?N/B#7K7YGfOeLp(Tj5$Z7'?Ox2lsP);NS97QKC2UgnvrE7K;πU"i2318#o5NHjWR%7VZ9dZtHEq]T7J]9#O5(iCy8Nn'p]qiwC:HQsK+V<]xw1aAKbπU"frfnQ^4$V*;hmHW;2)HYjn>:WYkr3;7mQKhJbSel&bTlVY6g=;4Am4o)25AS#ErπU"G7opEZXIBuIbUU6+yOe<(uJB(>?P)e7_DGu+C^rQW[mnk'?.8]TTbrLt\mPyhILπU"YJ1eeTpNoe?'78i%K#K.)?myl_B9&GjOgo1W,mMEjL#N#8?ShEOI2jrfxq9pK4RπU"ccx5nBC=Y><HKjZ8f\\^.Kj:k-eNA.hV>2O7P2/v\*VNh#/z&Ngk?X7SkYO+K%/πU"SQ<s>*2g1)siKD6j8&po7?cb3J%N%Wy[g_tP#=PD>a?S0T$0/.^dr_NN^HY/w(/πU"6_io9S+L?yhs5R8n>[al9:caZZ:qAs+&Vb&//#St1=U5BOpubu^d)Rn\QI;vCk^πU"L_4[6aPBu;2-VteF^l_GO'El4TcSIxfo7wO[c#,a_+ayI1N:V+Lp)9w5'3F<o6oπU"$OdeYk#G?,6\MR0Av)3.+a/v-[>ZA'f)k:.oYpOi]17cL:PDg1vhzn)zlbTQkXOπU"k(==lRTuhD9L7yD7A%o$t-6HQwRVykC+4e#/EDzaTP&5KXFw6=W=z4Df^Vz*^SuπU"BSfS)lru3(sU-4DQIB=J2*7\grwKVBEKJ2f5?[ZwqoCp'8+UEgrLv0]G1pjOmxKπU"=RlMKsv,nthl9L;&/w+df\vS)&r4Gl;8F=6e\IrRTJvBgTUz%Td#:-OqRR86jfpπU"yeg/$.&]1XV2M#LX6i-L:J^XJimj52,HE$AhF&1ign)n#X9P9uHqf>gL2i7g[waπU"B*uWI3<J,\/X;C3,H^-PVxN1)p[2-%/=YpNG]]]NG'U$[_.Cjtx5)ngK*=8+#3FπU"wu:&AtbZXlior8uC&N%tDJLBNU>jHu&18S>AopHvVot6FvA<\_7G-iMh0>*$=VLπU"p91-[GjiUjdUs(U\ES-3icr[VGPs>XxaP:i4S<&b2P4<>Qxk'R/;v/e'RNDjXMXπU":+q-jk&,c:;i#UG:3H*M&mC;N_U(9eXsrXZ:YTNKS+e7520bmYX)0'q\>*9jUOQπU".CT\TIoYKD[1C&#GqO[k7HKTe&=,UO>,H9q<-UY*_'PRnA24=;,:X0\A5h)uk:7πU"p=<2G[Y?MH+/8)Pw>mBr+/>XhB8/[9MD>0=yEaJL/e6LLY8r1;OdYaNin6L(YX4πU"yoAQisB:XdiNMVA.9LgJ/QHv7a(d%O6_5.dtK<17iOj%'WrBIlrZ[e[+IVEd-QEπU"<();:IsgrQ-W<cHI<#aKU?H]fBC1[bJ(7/s41a%&sT^+(KrW+(OsoL*KYO4AstaπU"Ef68(#=a]ds'aL^3b&7RALMAF^-x4JTfA;x5(*AVrJ+_.><1S?^;8O._9ZEL9oKπU"3k,+R)2N+E,qLO3^s(8]HH53&aY1ltc\J1EIuA9$z9CPmvg:[cSW4<Dao$fcO.(πU"_QpQn1GMe(F-Svb;:QGC^RX<FH^_4iY(t>M/GO95LPxx8z*735u<e3odk'Ng7C9πU"Q(k-D4Kh=]'30],D.T]2Ah4ALsg.j=uHre(Mhn-[=OtVkU#;NLiAYir>CfUE9hmπU"/tPJpI3i4'pY]KAH#cArL4Bli(jBTa85aS6GY5'u>(#$3?9M\<D>\TP_)st=qS)πU"d#=<\)Dy1bj;%md5>Lqmb&DMHfZx+-UqGPSN8HWbp^]#L\>v(SCXpdtD#mK?<,]πU"h-[Y:N3X;S-F\fcORonP,d8./BH_kUdP'ZMWYFvN:#K]6,B;KWjaG-9zY&A.lgLπU"JhyAdHNn%o;=P_WNZoy6LU8+VsJ6-*(zJ]K6_T;**&]FP%da-Rb%7+AktcOQX<\πU"N$^aE_$x?289YKZZ:Ad:Y6kqb.$iU(A/'?Q7#]Zo<%wKM&UFx>BF]kucHL&2Wo5πU"38AI_u=u#?\)u&5mlQ2Hi9aEbW&pH&*zm6NkKx0i^,:CUzg1Nn'0p?'bv>V%65JπU"\)6]^*<5Mp)7eKH]InqtAXSes16cdF]fZdgkr1'4K7-w(Ej1vTIQ[(q>:r'-G19πU"]GTL^[XFAMrZ2QTF[0Fxo>mS3bPFf-aQAZkYTaWa-EEduyd>0\&2<s?Ub9t.FvJπU"PZ2TuZoMuU503i5a.-gV3i\cFJ;$&nxJv<L(hE1&Y1V;>T=I)#PBfL>DEZ'6G#&πU"8=3?d%a\\o7oN80SVDVDW_4ktFk32Wl*+1i)cCBce]bhn2K9a#9t<u^mQs5pfI0πU"=n7F4RKP?mOQzF]ciSDOY8/Dq#wr%H*i>eLXZ,+M=EQFrlU1i*:D%Hh<OV';2'mπU"_,/xus,0lTm^I6OA]8O(Z=2Q2k/*_oF1KoR1Aro7lFdBWVLnx1nOxxi?9p%F=T(πU"X%J\=c(\U/M5)k9MFMvkg>5\[87GJn91SPZuSg5z,[S^8d*gh9i=Gm;>O79R%u2πU"z]4]=#;?G)+t]f.FISrm341j$.Z3F4A%^*>vPdun.y1)Isvfk:#H4NS/:$H1YRIπU"HHteN9gBq[S4%>09/hc2Mms=5;04d%zR*UrD)t].=Q#3nFKN??j)5oTCss6\$m)πU"?Ac$0tN'K]e'r9Kwxe(8Nnsu'2(.hwT<3JHmb)DeerCqGo]iI8,YW/iXK'IO=>fπU"=pY1/S_Y*]+P%bC:&Fi9>^9*_nqHGb&(a'&>TR^5e?,C>q?tW*0LF?^Ic$l[<=qπU"ha'>hekGtNdoUO9bQdbSR#oU)X^a?)#w2<Z8t.RWu(QY(hxnS*Vj9RUsdYF?P%fπU"xDliLstaLrGrU+$d?o^:PM:0n:M/6<K'A[u25hBlQQaL\H$[,+W07K*MQW(sH9aπU"tTU0HdXRkb#6J[e7YsO\8tmSPh;*VUo1vLwmNe-V%O0220Notwc<<]/;7zbLA-XπU"[Ao=>^pb^(?Z\)[g(u(Czy4s4X*osu7N[/2Ybw(FF1KZP&+jVrx/a5_*/VJ5y5SπU"]3TrvNq#2Qe9rp?gasX7PFW4(S(JQz'NKew6[QwI]2rR6X_31:noq.]/0lB?Xs*πU"pYkypGj2<uC[%3h?IWU>uw4Q(s.$mQB;mszk5jO2Hac)-fWN#0$5Y#3Bjaw>R(UπU"_8b5e,''?1Ay2+g22s5#^iA9J=vbpkLN?DdPs)1V&z>s13q]9WMqKk>:[aN3xG(πU"BC.zgI2]:Rle7?V&T:OZm2'duRkhm^BMS#/nG);oHkv#KI:-K+=OU2L:sf\#aT5πU"L9aNV)<\>djY2_:RX-R2*ZNY**5WjW1Z/]S[W+P(EsP'EJNS+n*?nrNxZh=V>DuπU")D:B'fZ8ZIj*ANl5Q>(3WDWFcTT4,;RX&&Q)WJ/pGeFH'5uZ,YMR(i5OU>fk:hvπU"lQHClliMo\<O+x3,dXhMJ*Vr\FP_YeZL..)u8A'W(:4X[Uo>l3OHOOU=Hohgd[&πU"%iw-kzxQFtO:#L>jBa?eM#L&B<PMqN8J/l.YGoR%Js;6dN(=\%G<H.uTjaat7m#πU">X)'?.mO<.4UL3/CjvL1C=2KFK$5ZW[Xl0)6MF3ZJgg734jP;*L);9BzAm=>H5$πU"*3Cgfg<leQR0CnepmeBg#xm\733-=qL4AogHG$gb*=Q_CX]f:*Vg=7Ho3AtU6K$πU"998Ae>G=$Es4W\$up20=eH2:^kTB[PVMTNLOmL(co9YvO/w^(gpj'1_3Wp=<5#vπU"&h]:z>&4^W_6(LHax;iXZQ(1Orhc.U5Nqsa#e.$O,CXc*PjFy4)S4QCZA$Qkd$8πU"T=M4+aXG7o5Ob/#Wj#Q&aX$5)Ao0SYN7^^\mF^Z#:)/s*Hnr5#JUu?f9T?Tav=-πU"=*)V^aiJzVE&<<?x001B_4h*X;#0+Xm/J,DE>XT1g6cj(O'0Z]^c#;-rYSrbIV3πU"%kyc1WHOnscNnMu;ul.MGI9Yi9Bg3umgRS)R2hhbbix_n2]D.(PSAV9[Cv^R6ZHπU"dLt3sszLHdnyB[Pn\5+KqP6ZbH(kdm:lZfQgH6Kp.^Dd$0j0zs5$gBcE74XG;v)πU"]N-G#Log]DIE4cRJyQrJkW31NgjN;d.arI,r%4;S=JE-,r7gX,7dkv),^)3EOLfπU"l8_l;D3eQsv$ah*K:K>/jj3W/J(gZsLl%2dw;hI_lC-T_C&<SrI_/_M;fFv%1iuπU"%,a.,x1mz*>O-/1*tGtrdd.^vdQPP,dd5\rDOp^6*[j>?-rs1SM8#R;cSEgoKt4πU"t0bn51Z>D\dPD'5wGsAt.D$fbKpW.Gr48ZM$.yDd<OypwV>M\'zKgub=nQnk($AπU"U2ipP-N^m,(-eZU0PudLXpDP$qEAWN.%yX-_sdn3:%PD$NQ?Vv&JV,?7e]0=e>4πU"\FSlT4[d=2*SG-D#iU8Jh(7]I#9X0#Fr,?afwKR2:>:jr(&AxkvVM.MUrGPJ8-mπU"BSgmXm=T*Q<Wvk/\]Q\P*<evHi=jaIkI)oQi)Tqu^Ki<Boy9+*8H/2$6ZGG)v&BπU"hil]F(QO4^I%zEx/jWV;pnlH^%PaBLK>G9Z#=g/U#re^&PBGX29q2D7'<rRPY7,πU"LtPS0hRHF;C50EZkxW3$7+KYrMM+JKJ*eOQ5bVAhVA8+;*JV7'w4iSrM<ib,TLoπU"hcG5=M[d0v?Q?k7\TDMVP1j7So9Nnr%z^,gn,Qa]J$#IeM9FB&/bv\%b>P-iHV_πU"-wuHhA4nCDdTSI4)BOGdvILQe>llaZPI4\o-vSXxg1-kp#]l65SjNhr:zkt&AhSπU"^d<VcLXliZgm[ASCS<CpRP3^urP([T3xe7^148UT9(D0?3.q>(y3.[K-yu[q5X$πU"^N&LB0D-M.<9UMwQT0FDJnz,GL#<pOY=ZC?JVe-H?(#eXOnRG>Vu,Q$V_Z:+T9[πU";H3-=2CM:x.j6cc,<x/;jor8.r$vfZOq)VDcVuERYJ0[I?sel9P7OX.LNiMpU&sπU"/_;ZMaH7PV[#$u+n/;HimiY%iqu/UtuNPl;OWGT)#mA)SLmH>lo31'Y(aWbIo-tπU"Zk81W2Ar:VLd-lJZ+PtUW:iCX#-NZ8?Ekl#%.0pi_0V*xS5ib5U<h6j=%SE/0%rπU"/Ss4^g,vM7TrK1$+C>ZORd),LRPDMp:R('RW9:u:p[\<-sYKNJ1>KY5jE7Zn4>LπU"5^O5U2ck6IbJR-of>Pq1^12r4Y2dJ^/2(]\\21;Cm(5iwgQV\l&$9av>I-KzsRHπU"v=C,vgy?OSV2j]feikT))FW$B5Z&Q(Hx>TLAC4BTYFfrG-3*Kn'lN2#$[-X+_.dπU"W4UCAsRh'^ju[p7RJ.,A2dbj>:pd*YFXgo1SF?*9/q,q=2#B*>je;xD/F^<^4rjπU"y[]*mm5m8F.dIT1g6Gc%B'dD0Ien^1I'Ms6Cip\&\Na8;k15&qZZ7$r_>(PAR1&πU"DRk[X9;m&'XiJhpZJO9N$AX_b&SsL:iFSmC0i1]eEPLP*-J>pSWH(P^Zx.f:oA:πU"dfC0,CaW]:]kGhx6(11O5)$52L'Mu/'omd'Nt<;oc2otHM'NDz9;-5CdIQjXraPπU"?S>4JWBvg?U*gXOD&2#Ap#p?)iM[sh4>#P#N(o9m&K)2&Z8a\nl>Y1D:ik[*_l=πU"q=uOFfarwm7Oy<10,edu^rAvle2^m>UzzuRA+WMa%QsrW;IzT$m44CEML2&w,15πU"o<?)S]*<];DD]D:Ss</];gNA9-.Z*W>TsAF0EfmMf*6=^0Ie8U,W8Xc1?u<#jn[πU"-Sl8J^S>;_q-ns10g>U_g,9+)Y'GSl>>ISq_U^bUxH*9)P6#gYeu6ObxV;XIxVgπU"k>njN-R]\P.uZD>Nh\+#XDnMA$c^T1#4gE^H;GFj,FC+8O>bLXkg'&0A.UyjX;_πU"+PyMD\zFk\gd'K_#)X[44aP0a_#a3[]pd73,^*\*f;*$^A0j)9\SOr*uS.Fu*,2πU"+j152Fr:Ou'F06BnH';[AfCAFIOdIlEcyMV_h=w%Q'cz=oP/>)_hh6pIlr^q>e]πU"KIBFmwzK:zGaR]9r48K*i8iey7,;D>Q;rW^#$6ioz]srrd(gK=<&Fi[]KtoK\n;πU"b&nDPl4hk7sSG5Z=i/XgHHq$JOJ*C*.Agb<q&\OW\NJ:23IV,ew'AsA'1=NbK'0πU"T4SUFFNh_Az/_ZmLdTRQ,?j^q?hcJ+w=J3,4oPTS17#E]J>#B.GowLxx1gr=7YfπU"-xc\=AfsoH<x)J_zNJ<(sse&X?Y.7nnjf=Lq8u%p()9%%%%-%%58FCACJu&-e)%πU"(%_3%%%0%%%%izs%ljts%SifyTfzT=BT]5L14_N5]qq9O<Ff#]HR-fa3?OI&3o\πU"$>2Z:)9mI^Ro-dp1n3>A<^$95<QYV&ZsZ^UGk&hX2^TtIC4Q<qWVQq[BMg;#e&sπU"zBU83BAM;DBEJ%(P(XCcZZhSI^Lc0',FhWT[vpk2AExrJ*UmEq(ql,1V6FwK-*HπU"^u4pqut;;R6_'xa1J&rrt.4/Hq2xuwE;T%^OlA-Ggr%$,G=]4q8n>85e^uTHC5gπU"\L[7GdxoEfyJ-;v,j)Q(M>TouR\Z/wXsU5ob:R4[/A*'I-1hhV;;lYprD<LRRT8πU"AdN$:u]&YYX$A>B7oEI3(&S&Yh3TxT^EJVn\a=j6_&_E\T+5=Ng9E7?AG,4(gSWπU"labdLNWZ:9.y<^rI?Yu=ZjKRf]IuM^.R7^iW&VS3&GDIA^bFB?-sKU>YBC52ek6πU"eq\erF+M:96uS>3vu_2T%Q-7,t0K$A:)P'Qr5,r,ZQ4>ouxMQk0.,=>M;W)Xk']πU"b[Q#>E<.or6;224EaVex#Ce?v>=qV:F]\)kIXXX_:%r$\n*vU'mC1ASmh48Fs/DπU"g3&sN0_JD7iq9A4VJgia9*_^*B'Jh92J)=;Y-3O4_v3A%Q\jMYO'tf9YAoIpR-gπU"ZNE6'IFa#G4ghVT'DO.+3%OM\Sjl^Z01YppQl.y3Ml>*5g:Db(/N)./a1Rni[(JπU"2J..Lk#Gst63]f;h/4gt7CIZR&9O._01bN*t?E%h:*i/e)/l-G8S/4p,[gwidUJπU"q54:4[OTOnTxhB*_uR'/Fxk1>>-W[NCcy8u&a&t<1BxK;94/r>/T/FW9ALI2G2qπU"+XX_eZ<R)cnW%ZfAt84nqjU1hh'/wi/j.ppG1v][.mrV>(abJ^nJMyQ3:dpVlZ+πU"QtpqJ8:1>P]&d&'.5jk2uol_%gZ*pf97'6^K=<8x,ngpsTR&;9i9ag*&ClMgbE5πU"Wc+OMI>xsY,86Kb12Jx<M18-;.0;)'.Dgrj<>kaThyye&-CV^p1vH9\t]kn.ZdgπU"9F9nxM3Z]=+i]K_FF;l).jInL1=eCp,Lszq%C%d)780;>^HR/&A*]IJo:WUP1yWπU">Yo3\5:7J*oPy?R_Z<8]T#STkk2Rj?T,K=*-yVIJj>_6#C-EN#R0hz*SPs-^#UsπU"V+^A.:4&]Vw=+PCO0PBc$8S5Jy:&?9)obJ*xLN[7JrRQG-UZb7^,MAU_lkjU<QhπU"bWr=Vx:?*(x+MF^:z&.LAyVuS(J<<[itZ=Ge544$xtku8pi)sk(2v.?LY4c9f#XπU"?:NYaBw6h?ueHxWu#6xwZq;\zTWPSnmwdgAjwnEgA\yL9(1s?QSMWN$s+X,cp(aπU"Vt3TjzcOm[PHW8^:WN:jC?k*XO4?Pcts?aW&^VU9YYrfDw??su4Z#+M>[:=o]T%πU"up()%9%%%%-%58IFA#V'F#P&7%%L&%%%1%%%%iz%slmn%lmSiIfy<^<:=;UR5ihπU"dfs4]H#cI3P/?IQg%vp6v2TIC8Df;V-n3L-v3tI\yV#w-v;lH4X'5wC6'2Mivq]πU"A:pRT#/kIbT'aXIuw]?PYQ3uX:+7lL%AcGq2=X]5mx:Vnobq1nlc[SCIH3X6oa)πU"JUD;#R&hsKj]4WBL.0Bv^37nQ=Ni6&%#Zn?FF%cRDRm1>YRhYG:y+]g_5h95OkPπU"7vgBx:-'Sl[oO#)nYZoNIV*-yJOaPLwi(RQlp2V^iAjPfi:%5AA^gbM?3c6f7o8πU"AavHrpy8wb[VONnS']BhW,Q+1V=TrAWOjeZC*Y^]?1CIqU]jkiICm&lMY)k+qDqπU")>ohj9qQG/6:[M.PIYd;\/iqt1a6cT)eVU;oW&>8cYAkHT&.up(%)9%%%%-%5%8πU"FA1]jpdL#%%%W%&%%1%%%%i%zslm%nlmSdsj&&k]4=<[U1jp+'v,go,+8S9GrecπEND SUBπSUB V2πU"[u,M[0&#<6%[&jW[=$ewW7q_]4:0BS*>:+;4]#$(8;0:f9ik?[*/MO/2:Im;llqπU"/SMLd[zs<>&Y1ARYX<kDlAW+zMDa\oU%jQ58Y;R3SbV,\&<;(:YrWAxbrR]]YcIπU"cw&yDJ61HK&lFVWPO?%m[\rEEqVkA#io#toXpC#DZy8U[>jrvN%5F]Q<%5W(GF]πU"SUMmL958lx8EGc010+oj)E8qDruHn3DK3J-sUV_WnF1Ydw'GTup%()9%%%%-%%5πU"8FA]rh?A&T%%%&*&%%%0%%%%zsmt1q(MV#StjD\_V3;[U1jpao6(cTu,T#HS_+WπU"8lH)FL_BJ;N08Ro]so9xh6L*B1*h_:eY6QZcw3SH?p^/a[+MXQ[q&fsb=c$(HxAπU"&p$=#hf-^S%l*;y)cDO)VjUzqBU^A/Z_Q18q75f?s8/_PoB0s?tk,tACV9.28vlπU"K'*<?;k^[,AkLD%up()%9%%%%-%58dFAo<5WIa%.%%9&%%%0%%%%uz%ynxn&MVSπU"x(lLup%/gV19U0Wf*WI;n>Nhn)k=6QYK_RC0?fr*r#xGMa;cUGq)57om6MT4id]πU"QfslSDM(N^CM-4D0);9q=Z6m?sY\h0d5X13M%,dmP2G&0%Q4_bjq*hL7wr7V24sπU"P^)\R5x9u%22l?,r+=\_%og.;?D%Q9S-kPG_-=nwDlfQ>__cf%qlyrH,n5&u%p(πU")9%%%%-(%d1$^E/K*(Uj%%+%A%%%%/%%%%wjf%irjS^y'y\'^wuu8?NFp=tFHx#πU"MtQ%7MMCtmToEF%rrvmnyyiC]HpQBamExioATAGoEPGH?L\^'-djmz.m+YLAtO9πU"t.KK6%2df4KLOc3sUOG_dSs;^tAeMIe\'f:4fsK5_&'NeeF+=MVZ[U=qqakE5J;πU"bo1u)+iiD?gGo3+aa'pPLvk*kAb95dsDua(m8l,ZnWoDABee%%%up%&'9%%9%%%πU"%-%58IFA3+4kg\%.%%:&%%%+%%%%%%%%%&%%E%%%%%%%%%gfxt%ttup%&'9%%9%πU"%%%-%58RFAiW.NwP%.%%+&%%%)%%%%%%%%%&%%E%%%'*%%%%gthf%up&'%9%9%%πU"%%-%%58FAN5vCR&P%%%&)&%%%*%%%%%%%%%&%E%%%%y&%%%ot%sjxu%p&'9%%9%πU"%%%-%5[8FAw#DUzI#%%%%%&%%)%%%%%%%%%&%%E%%+%q&%%%ozf%sup&%'9%9%%πU"%%-%%58FjAg;5(pU%%(%5&%%%+%%%%%%%%%&%E#%%%c%'%%x%frfj%qup&%'9%9πU"%%%%-%%58F%A#'e(=Q%%(%&&%%%+%%%%%%%%%&%E%%%%c%(%%y%fjqt%sup&%'9πU"%9%%%%-%%58FaAES0*v%B%4%d>%%%0%%%%%%%%%&%E[%%%]%(%%i%zslj%tsSg%πU"fxup%&'9%%9%%%%-%58.FACJ)u-e).%%_3%%%0%%%%%%%%%&%%E%%%&2F%%%izsπU"l%jtsS%ifyu%p&'9%%9%%%%-%5#8FA#,VF#P[&%%L%&%%1%%%%%%%%%&%%E%%+%πU"EJ%%%izs%lmnl%mSif%yup&%'9%9%%%%-%%58F7A1jp+dL%%(%W&%%%1%%%%%%%πU"%%&%E%%%%F%L%%i%zslm%nlmS.sj&u%p&'9%%9%%%%-%5[8FArRh?AT#%%%*%&%πU"%0%%%%%%%%%&%%E%%%%CM%%%zsmItq(M%VStj%up&'%9%9%%%%-%%58FAko<WI&πU"a%%%&9&%%%0%%%%%%%%%&%E%7%%EM%%%uz%ynxn&MVSx%lup&%'9%9%%%%-(%d1πU"$^E/K*(Uj%%+%A%%%%/%%%%%%%%%&%E#%%%V%N%%w%jfir#jSy'%yup*%+%%%%%πU"2%2+%<'%%%oO%%%%%πEND SUBπV2πCLOSE:IF S=1AND B&=Z&THEN?" :) Ok!"ELSE?" :( Bad!πSUB U(A$):FOR A=1TO LEN(A$):C=ASC(MID$(A$,A))-37:IF C<0THEN C=91+C*32πIF K<4THEN K=C+243ELSE?#1,CHR$(C+(K MOD 3)*86);:K=K\3:B&=B&+1πS=(S+C)AND 255:NEXT:LOCATE,1:?STRING$(B&*50\Z&,219);:END SUBπJonathan Hopkinson             SPACE DUEL                     www.smartlink.net              01-01-94 (02:24)       QB, QBasic, PDS        185  12281    SPCDUEL.BAS DEFINT A-Z:DIM SHARED K,S,B&,Z&:V1 'Created by PostIt! 7.2πSUB V1:OPEN "O",1,"SPACDUEL.ZIP",4^6:Z&=8950:?STRING$(50,177);πU"%up()%9%%%%-%68dFA&k1pLo>R%%>?%%%1%%%%xu%fhiz%jqSg7fxfb*RA#^kahπU"YY^do^WO=KqIJW_G7V;D14?SO'QB2J^IAIC[u:ie=/]l?;Nu-_d05O=$.SoMCL=πU"a&eu%zFtI/O)_]NmECIlw_9=o'dxAFKrQJY3&>F-f?&sk.&Z>sKT)OuPNk4g3JcπU"8l#D(nhJbNV?5iI<=4nQCllepE_(zo6Fc6?\pS'8<j_%*ve>AK3X_410cFNQHLOπU"k<%D;i9\sp-LlrdY$R7l[WqTP4^u9>,foJ3^,g30dMPunT-Q'US<4StfR%A>B[7πU"g(z1j>q>L/:w[NxauC<vDkZL//>*EypJ=#c;(y$o=bPc^OxHxG('#^Rt%5Nh>%BπU"[ZZ+(*Lar=PYKHXpPXu.<%6,e$0g]/YHCmN?;3w.dU;P,6l]abkhqXMH8r'5D+SπU"'S1f)q7#,)fnk<r%('+Hj]FnVLN8-sZR4DgPEEjHbl2JtBFw;m#,ijO<W0('\eeπU"XNoi#E,BBOK#=1?5j:XZJpd=o92]mTB#d0$pWQv$f0PHhBYk$XkV4;]Ltd<>ir-πU"Yre9tn/.BamisS'e2GRvV'mh2Gci3AE7mBa0j.4%67U4>-f1PiD]ke1c*>e60K/πU"bo#;QY;PigW:23npNu>v6G[iSl0l;jI-R5$cFl<&nc0w>qqS0Rf+QBr6ga=mIR\πU"/_Y8sEa3ht;^F2NR9[UwX-uTD-PuD-LDZ-HDW-DDyK&=ZdjCjg/^qgDQ&>%r/hEπU".M$Ic#g;dW^;?)3,4VrqZE>gQe[uDtDj/>HTeJ:.r0Ey*^lBWiW=&8n6p^&Ld,^πU"=8'PbU]Zn^s'_bm]ad4=B8Sftm(aUsWe^El#L=_E'^wt4>8RKlc)s&t/Umzmm5eπU"T0d?7L)&*9Ukl;b+Z'^TqPhDQ?CP'm&+m]j'G^R4U,=%*6tvBDG)_C9+G/1N+q'πU"F.BI^m:Xr;(.wT1\GI$1mFv&([QNE+e2G)pJc/L:I#MwpDO0&$KK\U=JX=azdw9πU"LOZI^=J4sRY)KAk.6Q<>fYbAECk>_cce&slWznhJj92,hyq\l+WCXzj8f<[zP/1πU"^ywG0VZBw;v2AtCDLpL<twk3azVJb(gb9>W5.(5<HQ&zFiG81/u&sM%3(z,)U=BπU"=G7t2<#B%SL<YY8JiLP&-nuJ?1(Ataxe/V$Q6N.]8D'd7xi;a\Ah8$+PIWcCp1gπU"V'zGRQza]d/mnCtdGx9KHN%<N/soDFbcSBu3zE+xUQ,*3GMIV%_QR5s/,]45V-bπU"lrCw7Rr,9:EYfh&Xnbso(mPG)>y&_vEIDlm'h[cQDUqqpdI8cEYVC_L[1m%8-$YπU"L/?8$[PB$RO'*csp46F.*ttWlec,1[Svf)Kg39S*Pk%%A#[6neiM]hrEYD[ae\:πU"pcKG0tb+<#7z<Ij=I&wQ2$vBn<<b4[-P%n&dR.vA.8NWBkI(4^jagq-cGO&r#TLπU":n6JCliok9UU,b[3fVBIb4AN='&Wy$Js%ZDs(Ovh<dea%H0po85K=:W73?Vwe/LπU"mQ#8#4NZgvAy(Iqu5IfIV_]dy:io.D=.'I70w<l5*95me>RCOc9r]Cm4XTGQ=R(πU"&vpn)>oS1QBY-N\0vySB;D.T^$KrC0f8CqS:9H&OSE&*97.VMp*\a)*+na04.hlπU"(6>GlQx)rz_G1Zirel^SG[7U9nh(4vw'*a(%VScmapq=hCj#_og6,JfYmQRLdHfπU"avi/msfSPJiCe'dDe,^UFW5pEc1,i^3^ss^f5beg>;h>lCV_[T^.guCMn-F''6CπU"%NB0:fC1X7d53ljE(DYEb*#TxG\?+bV\<7WiN)Xm9qCF-Csi.C?sf2BOPjNIHGNπU"U]/q[,62qGJrjEenHEPBo#C=JLm)B)PLOdW.V;#W^bzm7J#c5x$h3RCiOyRiBNbπU"m*OeQk0F:oPX60vn;y:Xu+HNlf5n_>0Qoq\jtPH/oBLeorjgvpMA$<uNRQL'H'7πU"9Z,A2%OLVfS#[R?P\GCWjrI02WU/gGE%eeIpRkW^G)sw)BTNebW3?7H_^7zD_mCπU"Bey'^vTzEJe#Ed;^fdnO>9[3M=j#jHvmE2e^62Rm0^Dv,nJTT=I:R$:m9kKc4rUπU"3G/hT>^S4Eg'77tv(G[WR3gv4J%^TNw*%_k<&>JeGLlqa'_Y2wKOi$]K1Y>ePC;πU"DFVFsOE&T;1FZIoj5NAMS;t/Ibf&PZctx0.xP3EoYj+&9M&q'On8)e$NrlEd$q]πU")ouz^/x=go);q3>-N7xfL3T9xg3pWQ5R=_&>4Z19(ksgP79Fg?PS=S+.9/SUC%*πU"ik$&8rLm8KO^.;[?)uof)_PV^eL+9O5:gR.f%l>RAF>q/)<7tyak/?XtPFdQ.ZlπU"Q^dsYG>9a\[LtAd8JaxbiH=rlr1+]\^Qy3I6YRZ?^(>=Vf?nb,E4Cj7':6w5NmDπU"z6]dKV0GLUG'c+mwJ7j#j\lR[rDImtY);2iJ(FaCY]HioBKP#y&RdiKfsyF-F1cπU"54JVUai=_W5EBGi6[JtnF+(G^ea.HU$0hqnV>%Jg<jKo[vBjSLjox1=N0>G'4gYπU"Wp7jaM4d_E64#;KbZbZ\9#u6iLrE)Gc]I.tP);wm(UE-87g=P8IK30nR5KnS&xhπU"MRS=NLIEC-Eb>W+$v6CH'Yggh%TR'HN&S\i.25^DVZ&*nTLJH*,lPwT6FU'f^a.πU"O(a/CT.ccH,#uRp5B=_^hhtQD5iTy/.:3R94//RJ5XEj3,;%V<LDBYojO(Q+dK+πU"UgYiR$>/u(JVb=1x<idd5ls67j6/H4=oY7f][7&<Z_fnuc:<0GLI>VzmsMcL^,KπU"nuvL\,>^c*Glh;=--qSYA10GsAhY(5aUSM158_Jpn:]$:#yrk0\;j*P\Q#keV6>πU"YqUA)=x_,$9ohL5_j-fP(j*ZvbecoR=vISi2IJcjX):3Vkc8h_3d+wTucS^>orTπU"N(m6$6uuqblFNaYL&'vYRb?OXF%KB'ILJNNe/lhl\MBI[h7du4BJR?ZM8J_G8*RπU"QE4,Ai;^88qPo5S4G;+)6ZT=(nMH]R0T47-ddj<\*$]&XB'G9G<?&*OzJa\H?)OπU"5i7(:-P?cw:/tB)il4-Wcu-I<wtzJF$RPF/#AopxeIE?=P1XtRe.X)S&J/8bO\.πU"q$MX^bJ(Loo/5C)^M+lRR0XkbxX,+fe69?e$)l_?4eE#c[HRN,a<uFjBsf$dDcWπU"u)O\X:;<b/=70,\-VRHC?3H,T<2hF=&c*kV/<tMJAqF>y&2aN#pe4H$*R5a:K6]πU"85lAV?=kL5k(I)PXB:Pt,OLhdS1b#HiW_e:[F3PAm)Rcgc75*?0jj;a(LgsTW2tπU"eL^<P;;5H*o:S_4g/-SZ$%;fa;U9lNuJnNj9_nAokvu&*8)f<Eo)q9$.\G)mv^VπU"-a%U+1FqD(8RJodzT-V?Z+y['JtE&#LAQjf8$dQ3s_Z&))oWN_k6*A10%kXlq$'πU"EgBBbRMQ38-gZ+QSk.)OZ\4T1W9d[,Q2)3mOElGZ=UnI3?#r2oYAHAA4qVn4osOπU"(wYi\2wOZrRr(&Hk;0lR_yzlF.=90uoMi6Key=N2M.6z8:VukG68r_G2[?20I4HπU"2W5HA_l>T='Dl_l;fI1(b'gHx9&mO3^MOvxj^>ziYxO-2p_?QE1;cp>Gp6$$XC3πU"\IC5DO8sZ5K_UQ,orgA<#rd&.B>xv'#P.t+b;c5msKe$pa*bA13lqn]K\CbR%mlπU"(Z7Bdwp,Ys&[,>OA*Z$xQ#7I=nXs,>LGg,/?O-%V1p[0P?%4_xc+N[lD/sH1<pcπU".'+3.DwG.0(do2E-c#,n0/P-VqZ+af(iW4AZ,0^c._[E\P*MOMgv]EJI;I33CdoπU"R806-D42l=U4xn8u2NN$<eldsIv4dU/L2=g9=M&q\;76J0M1E%a.x(Q6;r'/48bπU"p9H,V)$UL1vS)SppU'VrEQmq.?4:.SJNOf2jo6$^0:+IIc_CjRb7fw.;kFg6OD;πU"5AjvBwTI)2-^eGc-+C&>VI?9,<5Qj)+oA8nLi(S+O?i]itj[s*+fSWo;Sp9<?1>πU"c4Jr9]t[pYIWW(jJPy5myBok.t(e<rV+jRhR4>Ui-Ps6J'jq=/vN1XroM8&fD(0πU"1Tl(w]O#$JKPBi>Y)q.5w_:CzYx7qD(hh;lD&&:a^cOOVCKn&5CK6NYWQh\V?QrπU"/j6dzu1Eus%T+x;%hy2,bZ69tO<*L7Iz<ItPoPV1[HLu7P-I3_%[C0:jE6UWFb9πU"'i%8w<4C^<3sK'Z\&QAbRk%#n<w9.T^u$7/NJC$7#d]Mkl%jJoKOc-U_]>/<&hFπU"3/vYl54mCN78o90QxDz/6;mlfn3)P]M&Z,2)]ab\9>Wl^%Yx9B6W?iHc=3R$N8-πU"',Dg\wOXkF9[)k#OEGC\G7?$Wa$'A'G..]f()'Qu78S7cW':=81aVBEYp1R,B_3πU"jxqa)<LrWETX1cq&=wNbxAGeycm^-RSh^T=M>1Beo^qq)71uOAC(sLUlkM$I(QwπU"C_3_SAOxt'a/5(L;.N+/^jo)ZnxVw;DQAIwJv*HB29._O[oJ.P4SuTJ\dm7$))cπU"\z0pjX_>p]YnXaw;Ai?']*nldvp7)ffwta)49;.'K'mn?Y97CJPC0?6WH5DQbE<πU"[Ith^rNgPVro'5\lV5w0iy;ACe<dM4gD)5$/&2Cj.\$OlaR5q4rC0(ENoE:HNd;πU"yOt;E\O(\#]\dE^C#$v00A1Ze]q+-*'rqO7^4:bnU*#/Q)B#cyS%5GH3DbHKHQIπU"AXY,Te:Zo%.cN0=1n>4W%Xm'O)1rl5I^n+EdAHHlmv=r*dAg4*QYGOK13VAY'1IπU"R;52:J7C8+1liG0M29%yC,zAv)AbA*K;Yx,DrM4H)=q1g,oqrJtX?%uSTL)rm]mπU";48CQ9,23X*Ws0SgvTA=Ywp:B.*'BAnx)'5F'#>%TTad:DeOMoltoXG9FU%(-zoπU"Hem&X>irV4Xic%UMl'ELO5[AXA'F-MzwZXKGX/pNSTFk6DRqHP,EgS>E>)#R9<7πU"\361XwCfkpc(,Uqq#=Us'*Kdk7EAR%A(i_,;SH]i$_2Qaeot=+.ApHp\bRB_TicπU"[Vo9;b#=2d/avJ_TjK+PLp&Uv&mQXBO3tgN<LS:61g3H(a#GmjZ5[b>Y:PTio7PπU"M&qHpbQIS,$<IA0'\38$%Y2a?,W<9A.\9ZF>a7;/I,de.t^iN\%;Q<l%P[?f\M4πU"]g,,=9p=Yu=iEDl=R;SKkEdb*H\#f+/AocfYi8].$8t_OZ&F4KoKTof6IMU)\B7πU"'77RX/&V)J?AY.)/SI9/lUlxI/71>Tr;:2CBm3XJ_=9([IQheVs^MqTn4e=Q2opπU"9ldTVJBrL+jLH[rC(;v?,YF>vCVB[Pg0&>/:3GTP*\/63:)1j\fOlOt2&jPflJ\πU"GGuh5Rns*j\7k(.C'SM.0Y..Sd.V6J8Gi#6JWqVKy412l:vcP.wiZ(vUDA,y)GbπU"qzwW2bM(MM=$$X_OsJ8jkVnq[_bU[^dNRptWI9[#,D2R[i\x1J\zD8SEWLp%0vPπU"e4mP4$XacGQ83TGGIJ?'G:%v(bi#7e6h'kUm)+i)/XCGP9P4;MZiS2)O332,S>JπU"M2pIG'x.07*jx0Y2[Kp((<pU$QrasVJe#?HXkmnUQ^WM<^$ezsCjw^jfobPSe,RπU"gH7,a-]gO4+R,3iNsEtRlcRCS?ABSlkZK%#i7/?^P:W5^U+yu_hIS%I#LA\LC$:πU"^M]Pp/h&.'5)uJYVP]sKQsZ[Mnb#/bo)RcoM9*p/9sfMh(j=QfTBB?qEUantOFiπU"eX=jf)hndNa\8vD^dv'f2*FQOnYkxT1yKyg^AUP=X.\BB5cub?XHOoH>\j2>Hs,πU"?3gr]9cZj0$8[l=gn^Mo%0WRWSA4uoW7XDnG'%Gur&H&sBsV4GGW%+/E\W+A2$pπU"#(2u+#^_X%v717QL^e*O.2'tjYL3P/JGw#.mE[_*-gv-u:ck4;7O<4^t:5vR&?YπU"oc>L?=)NO+]?Mj-+j.NOk2M\9u*<SKQKmPP990%HH--q&H7NVgaEo5_-mb;JnbaπU"'.BWm<7Q..A^)[(e0s]3nvwJrg<hg+C3Sq?jv(,YNzm387sl>ZmaG$bl[P:d,.IπU"'\hn/+[0viVXH;)<Gu%o>8*#,lHECwiYHs\e[_R[EpprS;KxiGj?99t0b4]dfEAπU"%%qrb1:jeq'u&8WuX&^)+xN2S^Fo$CbRB,ctRIL$0y7-vb2*4CmS(-kjnq'jG_rπU"RLgG>x9,<mJbYKm]]HC)KLq\Nht,H*_GubE'>kn]Qv/oZ27u+$J4BoMLcalM6&rπU"^Yqu^D/Q7uH*U\(F=7Q\BT<lc'dY%=dO%neepV9LP7AW2r3':oO_);_;+V=,NfUπU"YV*L2/Z;9Y3duICUtk=L1p9HQN,Ta#G8;O>G[j_UEM0FRb;DIMtu^C$;G^1fpbbπU"&1fu;&bz6Q\lGI6i(0u/P61d;>[tAdiA-+TsPvVF.:6Bj;NW2q)jO;)3.E^W3TpπU"pvfFzz7;5r'Mh9*Eg1r\<TD7Q-H0TO(h_7,.-<c-Sv9>k%ZZB_/#L_j=tc4o[C/πU"Q8vsGY#YZN$>M0rFHB_E0;8t:Njn7c/]Q4=:x?89jT88Qxuc5]<+VcAK(x0b(RTπU"'39d%>:f?.Fje;-r?]I<9\Z*_hhOM5D%7BqeOd)F7:Hu*)dis\JDEX3OMwf),TrπU"C3IgO8,64qexP%_km(>Cn?<rceOeb5,(N+em+'qIS[]'olVU86&d0^[BX/=lJgQπU"$V,*5r<=7fR'j&BkTfRJGFN84b%wA,ikO(JG$DBD?)O%$Y9ZGY$1zSwp35^SE%MπU"0yH(J)oO;V6IMB,?[&(XC:ghvk'7Ih[BA(p[bte5<gu5N]UV*86zS,r/bC5^L(OπU"zWbvXX2lG>aN^b8H_LZJ^L(43WbvXs&TNb[*G,4X_P9Sh.\>h%_q26\ER#gn-]UπU"6kC1Jj.5r:?g,G,eWQgn((P0Q92f9o&bhZKcITqe3#wb$LOA-(i]g>xKS#<hH],πU">IN)*gxX[Yl(WE#QG&)_vru+Wh$8+eoPAazIh1.Hxp%pa,'jZ-\A[;wF$g7%)$8πU"dzgQF\XSD6aM00rm:jwH=s]P9irzVueyCH4=8RJ^rXXea$u>4rnDb$BLs3VBTO1πU"Extn/1(fI3Ztk(V0jKVkK%]j]_ts*8<[VMdS0-je^;DnG<N;'n;rgq:v439gMHeπU"<AW>:j>t;\&#LJK/,]F,oIbSQcE>)K,fTvl_[sHaP3,<XAjvhYs#UkT=?Il(M?9πU"-;'X^1_fl_=<tb#sSlFcJQesile+q?rSxX3CU\_Yv+3s1bSMhYF4:[us-PKBnDQπU"j_aZKl1#;Desa2_&LIMe=gYR^e]L%ucdzg5>fTGT#tdK>dKMAyUGnV.9rTKChdLπU"*lnctmzGU$HR0aRGT;zxQIv/aexOeQq6yC^>,*GbhMy+a8=ZBtm:qcjSZy:[d;8πU"El6)o[>Yx;rfB#XwT-l+n[2.VEtSqM.<HR4<W>k,uqHh&uj+AijjUXADO2V8QY(πU"U&][04-pP&ex1X$+RTppt)-6r6n*E[</hCEvL5TtSiA&8Aboc%)AKv9tnFr#JU0πU"9?dfg]anFIeJtJor+k>n/C:KSj&5J8VC5H.2WL;8&u7F+(0I4DOmU/gY;vJhjrLπU"SFplFLVnU_.I*O7b]CLSFs&p'7n,1e#v1&T211A,XhY^EAA4m-uoF+h^LH=$m[EπU"\eU[>R#+js,t,[RpyCfZR.pM=q3lk3Ro.d,G$BpIH+/$o5UtPY=,.aieA(b_gWWπU"2lO',6#%Xu-40^j]wc.7-PM85of4w3%Lm<CK#o>f3QU&Q.?EftsIr$D_XToIezfπU"gr1(Kmj_=g)1bHE^dRP(0cIqIY;L*Ab(/,$D3)7%K\tWDkD.tBPsW3&,.K<n*GGπU"0d'MSt\;2-#%nYD*bIJ-=Qq*l-lPRx;6*cnEkhx>HP?1XKeq4J<Yw'VDqNS_kolπU"2s<ISd.lWV[a.&p.\/>ZqUdmU(>%Ehg_pXSB2hUiCs&dr,ug9*6v&UU8Kz1NG35πU"/c9>k9Y1ZwGJ0/$tq'7DZ0kCecK:u4K^xJtI3F%,n%VDRinGl$8Z%2?-Iv9ESVPπU"=i,?NT4QUu8Fsc'ZQ^t\nj;L-s2B&z,Im180E<E8fwkIJfs0;'CVAQ1:4'aW(1[πU"h\YfW7fI,jGRD.&c8:3A,r:7:NPT*NBp'DaaJ0vS_XSJeBhVptQuA2VECb>n?X0πU"7DK(2=l^.sgknARYQ33oJFXFtfEdT?PU/Me_aRQ.9h$3RQI]59%.qZ>^<A5P\;>πU"=GsR#,$f2v>=k+Wu<Z[3sTHXT(=ZisbG[S)%JbbNBD8m<dF8R\31ca0Nz]gj4TtπU"tQIXl2bNot$wLcv6#u[+bAF:-&_]:[(IQW:/X/qondIjX=(+ED^(Cjv[;nyI'x&πU"up%()9%%%%-%%68FAQ-sSP'7&%%%p(%%%1%%%%xufh%izjq%SifyD,bf:BUU5T<πU"hPu,u\l1APe^;^k<0TKIK)Epnt\*NT?'(4aI2Jr$nl\kW/pA:u<5J5n>kSs+U'^πU"t9g9f^-PMNju&[HfFrvVljg]gZ;g%MHooF'BE4'xZ'E$j$Xi8RgXk8iEH]+i<GZπU"qF.#*2fY[45COcL]QCs=c=*?^a$U\r)CoTd]kXTV5ehB9U-8tsFR>t4-BNhC6o6πU"\4_;WcFR\pC[6&3sXWI+8;/[wrfrx^5a9bV9;X)[DVhpxH+I]^jH#?*st,DwIy0πU"nq,u8wG$?_1XCeI(R+DHV-jMP=Is)#og&[wF/[M,#ataw8$A$PNmUZD5*PK7NH-πU"X-kk[)DH6LD<KA?230n\i)i*shF(o9^?U;quAufN$9bGREB(e+YB&bK'xA&s6\aπU"R^pRgM-J7)NGw/6CMG87J>n[3-)SeX,kv?&h3C_yhk]G-C?vbC:p'j:onAoN<m_πU"rwe60la(j#q,GR9)G%eVVS[S2)7rQKfEVMy2WZ't>UMc.J0%#Y5WR-uF5w%h$?eπU"(HLasp[,e8&cCHWJ*;7?obl$KBlPHo+3ql9sLrVW'u&up%()9%%%%-%%68FACF+πU"%,'<&%%%P3%%%1%%%%xufh%izjq%SlwuEf%p]]ce1Upd8g9m*G.xlglneFJ/FpMπU"8_5P.WX1x7/s0d?^+<j:S.xS*QEa0Z)*XMQqUA9GQ81?I(&K=3qpHD<iL9#IehMπU"0AHX%=)i--r?v.j)JGWOFGep&Y*g[q2>6jkrqD-rKCyfwn)\ne_O)V9*)_xr*oLπU"q)MBJUTC*k,[x,f]bC$Cv3sB'1h#?:*YfAW4N[TF=X:gSg,9S2a$[2V+z-tc:kZπU"tP5Wd8WU$Jugu;d5\$A^4D4m.1c.T,7WO#^d>\=JkvUAd^_?$h6O/E3cuo>8=-KπU";dmjo7s2k9sa-&hVn<%UKu8<J0B>OkQGpRn*_n?ugaQc5,-6>g_Z,,,R2.g-EfpπU"zsZ]ZO<M[bdOI'75=df6e\-K)x:=gUh,4BIaCRIb0a6IBEo-yijV:.W#Dm+&zZ8πU"m5c(t,P8Dim/(wmr0+1ZqVhCd_.<]i<a<+300o50rB0ImmOD3?=6dZRS:6BQm^XπU"'rZjr4KHHZ[Z<=stGnqA+tvmASK+meKKC-P,9UYvt,&hT)vd#=nAp&5Wo%K)O,2πU"nvf7ThB3hGay.A^c.eD-$qP4u+Fq4u%p()9%%%%-L%b]>pE#t]-)[%%(%+&%%%1πU"%%%%xuf%hizj%qSmn%lbur%p(V5T60wVG_lAii..-LDY1:tp/m,fB).rbaWBCoBπU"X$8(:FVpVkHlgGZUXb,Z7W?YhspJY6#C:s/'YgRSg2L6Lg&dDMc?1Dj*_$N2rZ6πU"<gY;/D$ez_cc#Lj<[?;7c4M#_ufqwK%b-)6Lr_bL9U^[pk9f0[jO/%o:$dLwtk[πU";tGdp=KB2]31.fd[PctW5kEqtjkfFvRUwV^Pqne8Bm'^\sqcseQHSW$'l[2<W#wπU"4[xjd=QEq5<KoWh7NF/e?bs_/L7Ng5qpdhxi1+0$=NiZ;,1w'u%p()9%%%%-%%6πU"8FRA$qz*?[%%+%I&%%%1%%%%xuf%hizj%qSxm(uDtf%3)F-'4tWdBZ%']ZhxR)fπU"I.2+mn^QK1wdc?U8bW&0TU9E=Lu7kqo$]W&39#oT?e7D'*'OmfZn$6>>ve>G\6LπU"jG\<30hSAgI5C%uUZZ9+W,c)Hu&Y?i4C'b\]pp]5GCVDFPeNhHl;EbR$kB4n8'NπU"tDPPMr]r\*2dumstaFNwCne%Dup(%)9%%%%-%6#8FABc'Tzv#%%%2%-%%0%%%%xπU"%ufhi%zqSl7wufy;*]<UO-u.x,FA*GF&?)nNx3:RQd?^d^[nvlmh/?\J0=DrcPHπU"k19.-p4RMf24l;vx$F)%cD>ckJ.hrKE>ai&kmeP_.T^X'QRgF96%cP9Sils#OXdπU"6SI/<C888c2=M;\%-WcuDacPt\2=&\;r1B[7d'/jk'Wr<[Ob4iJ1N\MAdR0[F2[πU"cWhE=eMGJmb6rED&9\B2z\oDw<1MZ.),YBULp,NU1uxbI[ch?CZG_2/b'=o9tScπU"/R2,7&hJS'os5$\^EKY+.?WXL^fhu'E<9Y=:<<4uPd\[D;9_X25NC7/)nnKmgyNπU"UGH]dU0miS34S.u%p()9%%%%-(%?1$%EgZV(Xm%%+%D%%%%/%%%%wjf%irjS^y'πU"y\'^wuu%-Smq.sz?N+rFvM.tQ%M+MCtT=oEFr#rvmysyiCH7pQBmoExiAsTAGEsπU"PGHLH\^':'lmzmC+YLt.O9tKCK6%d)f4KO2c3sOPG_dsO;^teIMIe'mf:4sUK5_πU"'%Nee+f=MV[QU=qaYkE5;gbo1)Z+ii?egGo+)aa'PtLvkkAAb9d*sDu(Tm8lZBnπU"WoA/Bee%%%up&%'9%9%%%%-%%68F:A&kp)Lo>%4%>?%%%1%%%%%%%%%&%E%%%%%πU"%%%%x%ufhi%zjqS%gfxu%p&'9%%9%%%%-%6[8FA-isSP7%&%%p%(%%1%%%%%%%%πU"%&%%E%%+%C>%%%xuf%hizj%qSif%yup&%'9%9%%%%-%%68F.AF+%,,<&%%%P3%%πU"%1%%%%%%%%%&%E[%%%+%#%%x%ufhi%zjqS%lwuu%p&'9%%9%%#%-%bD]>E#ut])πU"[#%%%+%&%%1%%%%%%%%%&%%E%%(%nB%%%xuf%hizj%qSmn%lup&%'9%9%%%%-%%πU"68FRA$qz*?[%%+%I&%%%1%%%%%%%%%&%E#%%%z%C%%x%ufhi%zjqS%xmuu%p&'9πU"%%9%%%%-%6#8FABc'Tzv#%%%2%-%%0%%%%%%%%%&%%E%%(%0D%%%xuf%hizq%SlπU"wu%up&'%9%9%%%%-%&?1$E%gZVX&m%%%'D%%%%/%%%%%%%%%&%E%.%%VE%%%wj%πU"firj.Sy'y%up*+%%%%%%,%,%&b&%%%rF%%%%%πEND SUBπCLOSE:IF S=53AND B&=Z&THEN?" :) Ok!"ELSE?" :( Bad!πSUB U(A$):FOR A=1TO LEN(A$):C=ASC(MID$(A$,A))-37:IF C<0THEN C=91+C*32πIF K<4THEN K=C+243ELSE?#1,CHR$(C+(K MOD 3)*86);:K=K\3:B&=B&+1πS=(S+C)AND 255:NEXT:LOCATE,1:?STRING$(B&*50\Z&,219);:END SUBπKevin Fowlks                   TIC-TAC-TOE VIA MODEM          [e-mail]                03-17-96 (20:15)       QB, QBasic, PDS        326  8244     TTTMDM.BAS  REM KD Software aka Kevin FowlksπREM Tic tac toe via modem v3.0πππREM Note this program was writtem in 3 hours so i bet there are a few bugsπREM please modfiy this program any way you like, but please give me creidtπREM also if you to fix / change this program then send me a copy atπREM [e-mail] attached files are cool at the addressπππREM Fixed one of the many bugs in this versionπREM fixed Some more bugs now i all most sure it works okππREM Damit damit i overlooked one simple problem i must convert the data toπREM strings sorry about that guys :)ππREM This version should work also push esc to escapeππDECLARE SUB cir (x%, y%)πDECLARE SUB movex (x1%, y1%)πDEFINT A-ZππREM dymamic$πRANDOMIZE TIMERπCONST true = 1, false = 0πππDIM grid(3, 3) AS INTEGERππCLSπCOLOR 7ππINPUT "Enter Com Port (1/2) "; port$πPRINT "Opening Com" + port$ + " Opening port for 9600 baud"πOPEN "COM" + port$ + ":" + "2400,N,8,1,ASC" FOR RANDOM AS #1πππINPUT "[C]ALL OR [W]AIT: ", AN$πIF AN$ = "W" OR AN$ = "w" THENπserver% = falseπPRINT #1, "ATS0=1" + num$: PRINT "WAITING FOR CALL"πELSE IF AN$ = "C" OR AN$ = "c" THEN INPUT "ENTER NUMBER ", num$: PRINT #1, "atd" + num$πserver% = trueπEND IFπππππDOπINPUT #1, test$πBaud$ = "CONNECTED 9600"πBaud2$ = "CONNECTED 2400"πIF test$ = "BUSY" THENπPRINT "Line Busy try later"πSLEEPπENDπEND IFπLOOP UNTIL test$ = Baud$ OR test$ = Baud2$ OR INKEY$ = CHR$(27)π'hh:πππππ IF server% = true THENπ PRINT "This computer is the server": turn% = 1π ELSEIF server% = false THENπ PRINT "This computer is the host": turn% = 2π END IFπππSCREEN 13πππREM tic tac toe     πREM Draw Boardπx% = 320 / 4 'center the dam thingππLINE (0 + x%, 50)-(150 + x%, 50), 9πLINE (0 + x%, 100)-(150 + x%, 100), 9πLINE (45 + x%, 10)-(45 + x%, 140), 9πLINE (100 + x%, 10)-(100 + x%, 140), 9πππππDOπIF server% = true THENπREM Caller's program and x'sπSELECT CASE INKEY$ππREM 90,15:REM  140,15:REM   190,15πREM 90,60      140,60       190,60πREM 90,110     140,110      190,110ππCASE "7": CALL movex(90, 15): grid(1, 1) = 2: Ikey = 7πCASE "4": CALL movex(90, 60): grid(1, 2) = 2:     Ikey = 4πCASE "1": CALL movex(90, 110): grid(1, 3) = 2:   Ikey = 1ππCASE "8": CALL movex(140, 15): grid(2, 1) = 2: Ikey = 8πCASE "5": CALL movex(140, 60): grid(2, 2) = 2: Ikey = 5πCASE "2": CALL movex(140, 110): grid(2, 3) = 2: Ikey = 2ππCASE "9": CALL movex(190, 15): grid(3, 1) = 2: Ikey = 9πCASE "6": CALL movex(190, 60): grid(3, 2) = 2: Ikey = 6πCASE "3": CALL movex(190, 110): grid(3, 3) = 2: Ikey = 3ππCASE CHR$(27): ENDππCASE ELSEππππIF win% = 1 THEN PRINT "You win% player"; num$ππIF turn% = 1 THENπLOCATE 20, 5: PRINT "Make your move"πIF Ikey = 7 THEN PRINT #1, "1", "1": turn% = 2πIF Ikey = 4 THEN PRINT #1, "1", "2": turn% = 2πIF Ikey = 1 THEN PRINT #1, "1", "3": turn% = 2ππIF Ikey = 8 THEN PRINT #1, "2", "1": turn% = 2πIF Ikey = 5 THEN PRINT #1, "2", "2": turn% = 2πIF Ikey = 2 THEN PRINT #1, "2", "3": turn% = 2ππIF Ikey = 9 THEN PRINT #1, "3", "1": turn% = 2πIF Ikey = 6 THEN PRINT #1, "3", "2": turn% = 2πIF Ikey = 3 THEN PRINT #1, "3", "3": turn% = 2ππEND IFπππππππIF turn% = 2 THENπLOCATE 20, 5: PRINT "Wait for computer2 to move"πINPUT #1, cpua$, cpub$ππREM 90,15:REM  140,15:REM   190,15πREM 90,60      140,60       190,60πREM 90,110     140,110      190,110ππREM read and convert incomeing dataππIF cpua$ = "1" AND cpub$ = "1" THEN ma% = 90: mb% = 15πIF cpua$ = "1" AND cpub$ = "2" THEN ma% = 90: mb% = 60πIF cpua$ = "1" AND cpub$ = "3" THEN ma% = 90: mb% = 110ππIF cpua$ = "2" AND cpub$ = "1" THEN ma% = 140: mb% = 15πIF cpua$ = "2" AND cpub$ = "2" THEN ma% = 140: mb% = 60πIF cpua$ = "2" AND cpub$ = "3" THEN ma% = 140: mb% = 110ππIF cpua$ = "3" AND cpub$ = "1" THEN ma% = 190: mb% = 15πIF cpua$ = "3" AND cpub$ = "2" THEN ma% = 190: mb% = 60πIF cpua$ = "3" AND cpub$ = "3" THEN ma% = 190: mb% = 110πππCALL cir(ma%, mb%)πππgrid(VAL(cpua$), VAL(cpub$)) = 2: ' turn% = 1πIF cpua$ > "" THEN turn% = 1πππEND IFππππππ  π   v = grid(1, 1)π   v2 = grid(1, 2)π   v3 = grid(1, 3)π  π   b = grid(2, 1)π   b2 = grid(2, 2)π   b3 = grid(2, 3)ππ   n = grid(3, 1)π   n2 = grid(3, 2)π   n3 = grid(3, 3)ππ'LOCATE 1, 1π'PRINT v; b; nπ'PRINT v2; b2; n2π'PRINT v3; b3; n3ππππIF grid(1, 1) = 2 AND grid(2, 2) = 2 AND grid(3, 3) = 2 THEN win% = 1πIF grid(3, 1) = 2 AND grid(2, 2) = 2 AND grid(1, 3) = 2 THEN win% = 1πIF grid(2, 1) = 2 AND grid(2, 2) = 2 AND grid(2, 3) = 2 THEN win% = 1ππIF grid(1, 1) = 2 AND grid(2, 1) = 2 AND grid(3, 1) = 2 THEN win% = 1πIF grid(1, 2) = 2 AND grid(2, 2) = 2 AND grid(3, 2) = 2 THEN win% = 1πIF grid(1, 3) = 2 AND grid(2, 3) = 2 AND grid(3, 3) = 2 THEN win% = 1ππIF grid(1, 1) = 2 AND grid(1, 2) = 2 AND grid(1, 3) = 2 THEN win% = 1πIF grid(2, 1) = 2 AND grid(2, 2) = 2 AND grid(2, 3) = 2 THEN win% = 1πIF grid(3, 3) = 2 AND grid(3, 2) = 2 AND grid(3, 3) = 2 THEN win% = 1ππIF win% = 1 THEN PRINT "You win% player"πππππREM If you called the personπEND SELECTπ  ππELSEIF server% = false THENππSELECT CASE INKEY$ππREM 90,15:REM  140,15:REM   190,15πREM 90,60      140,60       190,60πREM 90,110     140,110      190,110ππCASE "7": CALL cir(90, 15): grid(1, 1) = 1: Ikey = 7πCASE "4": CALL cir(90, 60): grid(1, 2) = 1: Ikey = 4πCASE "1": CALL cir(90, 110): grid(1, 3) = 1: Ikey = 1ππCASE "8": CALL cir(140, 15): grid(2, 1) = 1:  Ikey = 8πCASE "5": CALL cir(140, 60): grid(2, 2) = 1:  Ikey = 5πCASE "2": CALL cir(140, 110): grid(2, 3) = 1:  Ikey = 2ππCASE "9": CALL cir(190, 15): grid(3, 1) = 1: Ikey = 9πCASE "6": CALL cir(190, 60): grid(3, 2) = 1:  Ikey = 6πCASE "3": CALL cir(190, 110): grid(3, 3) = 1:  Ikey = 3ππCASE CHR$(27): quit = 1: ENDππCASE ELSEπππ π   v = grid(1, 1)π   v2 = grid(1, 2)π   v3 = grid(1, 3)π π   b = grid(2, 1)π   b2 = grid(2, 2)π   b3 = grid(2, 3)ππ   n = grid(3, 1)π   n2 = grid(3, 2)π   n3 = grid(3, 3)ππ'LOCATE 1, 1π'PRINT v; b; nπ'PRINT v2; b2; n2π'PRINT v3; b3; n3πππIF grid(1, 1) = 1 AND grid(2, 2) = 1 AND grid(3, 3) = 1 THEN win% = 1πIF grid(3, 1) = 1 AND grid(2, 2) = 1 AND grid(1, 3) = 1 THEN win% = 1πIF grid(2, 1) = 1 AND grid(2, 2) = 1 AND grid(2, 3) = 1 THEN win% = 1πIF grid(1, 1) = 1 AND grid(2, 1) = 1 AND grid(3, 1) = 1 THEN win% = 1πIF grid(1, 2) = 1 AND grid(2, 2) = 1 AND grid(3, 2) = 1 THEN win% = 1πIF grid(1, 3) = 1 AND grid(2, 3) = 1 AND grid(3, 3) = 1 THEN win% = 1πIF grid(1, 1) = 1 AND grid(1, 2) = 1 AND grid(1, 3) = 1 THEN win% = 1πIF grid(2, 1) = 1 AND grid(2, 2) = 1 AND grid(2, 3) = 1 THEN win% = 1πIF grid(3, 3) = 1 AND grid(3, 2) = 1 AND grid(3, 3) = 1 THEN win% = 1ππIF win% = 1 THEN PRINT "You win player"ππIF turn% = 1 THENπLOCATE 20, 5: PRINT "Make you move"ππIF Ikey = 7 THEN PRINT #1, "1", "1": turn% = 2πIF Ikey = 4 THEN PRINT #1, "1", "2": turn% = 2πIF Ikey = 1 THEN PRINT #1, "1", "3": turn% = 2πIF Ikey = 8 THEN PRINT #1, "2", "1": turn% = 2πIF Ikey = 5 THEN PRINT #1, "2", "2": turn% = 2πIF Ikey = 2 THEN PRINT #1, "2", "3": turn% = 2πIF Ikey = 9 THEN PRINT #1, "3", "1": turn% = 2πIF Ikey = 6 THEN PRINT #1, "3", "2": turn% = 2πIF Ikey = 3 THEN PRINT #1, "3", "3": turn% = 2πππEND IFππREM read and convert incomeing dataπIF turn% = 2 THENπLOCATE 20, 5: PRINT "Wait for computer2 to move"πINPUT #1, cpua$, cpub$πππIF cpua$ = "1" AND cpub$ = "1" THEN ma% = 90: mb% = 15πIF cpua$ = "1" AND cpub$ = "2" THEN ma% = 90: mb% = 60πIF cpua$ = "1" AND cpub$ = "3" THEN ma% = 90: mb% = 110ππIF cpua$ = "2" AND cpub$ = "1" THEN ma% = 140: mb% = 15πIF cpua$ = "2" AND cpub$ = "2" THEN ma% = 140: mb% = 60πIF cpua$ = "2" AND cpub$ = "3" THEN ma% = 140: mb% = 110ππIF cpua$ = "3" AND cpub$ = "1" THEN ma% = 190: mb% = 15πIF cpua$ = "3" AND cpub$ = "2" THEN ma% = 190: mb% = 60πIF cpua$ = "3" AND cpub$ = "3" THEN ma% = 190: mb% = 110πππCALL movex(ma%, mb%)ππgrid(VAL(cpua$), VAL(cpub$)) = 1πIF cpua$ > "" THEN turn% = 1πEND IFπEND SELECTπEND IFπLOOPππCLOSE #1πENDππSUB cir (x%, y%)πCIRCLE (x% + 13, y% + 13), 13ππEND SUBππSUB movex (x1%, y1%)πLINE (0 + x1%, 0 + y1%)-(18 + x1%, 18 + y1%)πLINE (0 + x1%, 18 + y1%)-(18 + x1%, 0 + y1%)ππEND SUBππAlan Bruzzi                    SPACE INVADERS                 FidoNet QUIK_BAS Echo          03-12-96 (19:38)       QB, QBasic, PDS        68   2919     INVADER.BAS 1  DIM A$(10, 5), FLAG(10, 5), PS(40), PT(40)π  RANDOMIZE 10π  SCREEN 13: CLSπ  DX = 1: DY = 1: DDX = 1: X3 = 20: X1 = 20: Y1 = 23: SC = 0: C = 0π  JK = 0: SHIPS = 3: COLOR 1: I1 = X1: JJ = 0π  COLOR 15: LOCATE 24, 1: FOR T = 1 TO 40: PRINT "-"; : NEXTπ5  COLOR 3: LOCATE 17, 5: PRINT "███"π   LOCATE 18, 4: PRINT "██"; : PRINT "1"; :  PRINT "██"π   LOCATE 19, 4: PRINT "██ ██"ππ   LOCATE 17, 20: PRINT "███"π   LOCATE 18, 19: PRINT "██"; : PRINT "2"; : PRINT "██"π   LOCATE 19, 19: PRINT "██ ██"ππ   LOCATE 17, 34:  PRINT "███"π   LOCATE 18, 33:  PRINT "██"; : PRINT "3"; : PRINT "██"π   LOCATE 19, 33:  PRINT "██ ██"ππ  FOR Y = 1 TO 5: FOR X = 1 TO 10: A$(X, Y) = CHR$(234): FLAG(X, Y) = 0: NEXT: NEXTπ  FOR J = 2 TO 10 STEP 2: FOR K = 2 TO 20 STEP 2: PS(K) = K: PT(J) = J: NEXT: NEXTπ  MISY = PT(10)π15 X = 1: Y = 1: FOR J = 2 TO 10 STEP 2: FOR K = 2 TO 20 STEP 2πIF FLAG(X, Y) = 0 THEN LOCATE PT(J), PS(K): COLOR INT(RND(1) * 15) + 1: PRINT A$(X, Y)πX = X + 1: IF X > 10 THEN X = 1πNEXT: Y = Y + 1: IF PT(J) = 22 OR SHIPS <= 0 THEN LOCATE 10, 17: PRINT "GAME OVER": FOR O = 1 TO 100000: NEXT: GOTO 1πNEXTπFOR M = 1 TO 5000: NEXTπGOSUB 50: GOSUB 300πLOCATE 1, 1: COLOR 15: PRINT "SCORE ="; SC: LOCATE 1, 30: PRINT "SHIPS ="; SHIPSπGOSUB 100πIF Y1 <= 2 THEN JJ = 0: LOCATE Y1, X1: PRINT CHR$(32): Y1 = 23πIF JJ = 0 THEN Y1 = 23πIF JJ = 1 THEN I1 = I1: LOCATE Y1, I1: COLOR 15: PRINT CHR$(254): FOR L = 1 TO 500: NEXT: GOSUB 200: LOCATE Y1, I1: PRINT CHR$(32)πY1 = Y1 - 1πFOR J = 2 TO 10 STEP 2: FOR K = 2 TO 20 STEP 2πLOCATE PT(J), PS(K): PRINT " "πNEXT: NEXTπFOR M = 1 TO 5000: NEXTπGOSUB 50πGOSUB 300πFOR X = 2 TO 20 STEP 2π   PS(X) = PS(X) + DDX: IF PS(X) > 38 THEN DDX = -DDX: FOR Y = 2 TO 20 STEP 2: PT(Y) = PT(Y) + 1: NEXTπIF PS(X) = 0 THEN PS(X) = PS(X) + 2: DDX = -DDX: FOR Y = 2 TO 20 STEP 2: PT(Y) = PT(Y) + 1: NEXTπ   NEXTπ   GOTO 15π50    LOCATE 23, X1: COLOR 14: PRINT CHR$(127)π      RETURNπ100 A$ = INKEY$: IF A$ = "" THEN RETURNπ    IF A$ = "," THEN LOCATE 23, X1: PRINT " ": X1 = X1 - 1: A$ = ""π    IF A$ = "." THEN LOCATE 23, X1: PRINT " ": X1 = X1 + 1:  A$ = ""π    IF A$ = " " THEN JJ = 1: I1 = X1π    IF A$ = CHR$(27) THEN ENDπ    IF X1 = 0 THEN X1 = X1 + 1π    IF X1 = 39 THEN X1 = X1 - 1π    RETURNπ200 FOR J1 = 2 TO 10 STEP 2: FOR J2 = 2 TO 20π    IF FLAG(J2 / 2, J1 / 2) = 0 AND I1 = PS(J2) AND Y1 = PT(J1) THEN A$(J2 / 2, J1 / 2) = " ": FLAG(J2 / 2, J1 / 2) = 1: BEEP: JJ = 0: Y1 = 23: SC = SC + 10π    NEXT: NEXTπ    RETURNπ300 IF JK = 0 THEN GOSUB 400: MISY = PT(10) + 1: JK = 1: MM = PS(M)π    LOCATE MISY, MM: COLOR 15: PRINT CHR$(254): FOR L = 1 TO 2000: NEXT: LOCATE MISY, MM: PRINT CHR$(32)π    MISY = MISY + 1: IF MISY = 23 THEN JK = 0π    L = SCREEN(MISY, MM): IF L = 127 THEN SHIPS = SHIPS - 1: BEEP: FOR T = 1 TO 1000: NEXTπ    RETURNπ400 M = INT(RND(1) * 20) + 2: N = M MOD 2π    IF N = 1 THEN 400π    RETURNππJustin Pasher                  BOX-CAR RACES                  FidoNet QUIK_BAS Echo          03-18-96 (18:06)       QB, QBasic, PDS        268  6299     BCRACE.BAS  'Try this code. Maybe looks a little nicer. I wrote this about 3 yrs agoπ'and haven't looked at it since, so many improvements can be made.πON ERROR GOTO 55000πMONEY = 50π1000000 CLSπSCREEN 8πPRINT "                          WELCOME TO THE BOX-CAR RACES  v1.3"πPRINT : PRINT "                          TODAY'S ODDS ARE AS FOLLOWS:"π LOCATE 2, 1: PRINT "$"; STR$(MONEY); ".00"πRANDOMIZE TIMERπDEF FNODD1 = INT(10 * RND) + 1πDEF FNODD2 = INT(10 * RND) + 1πDEF FNODD3 = INT(10 * RND) + 1πDEF FNODD4 = INT(10 * RND) + 1πDEF FNODD5 = INT(10 * RND) + 1πA = FNODD1πB = FNODD2πC = FNODD3πD = FNODD4πE = FNODD5πCOLOR 2πPRINT : PRINT "BOX #1 : "; A; " TO 1"πCOLOR 3πPRINT : PRINT "BOX #2 : "; B; " TO 1"πCOLOR 5πPRINT : PRINT "BOX #3 : "; C; " TO 1"πCOLOR 6πPRINT : PRINT "BOX #4 : "; D; " TO 1"πCOLOR 8πPRINT : PRINT "BOX #5 : "; E; " TO 1"πCOLOR 15πIF MONEY = 1 THEN BET = 1: GOTO 24π23 LOCATE 14, 10: PRINT "                                              "πLOCATE 14, 1: PRINT "WHAT IS YOUR BET (IN DOLLAR AMOUNTS ONLY, " + "<ENTER> for ALL)--->";πINPUT BETπIF BET = 0 THEN BET = MONEYπIF BET > MONEY THENπ   LOCATE 16, 1: PRINT "YOU DON'T HAVE "; STR$(BET); " DOLLAR(S)!"π   GOSUB 50000: LOCATE 16, 1π   PRINT "                                         ": LOCATE 14, 65π   PRINT "        ": GOTO 23πELSE IF BET < 0 GOTO 27πEND IFπBET = INT(BET): IF BET = 0 GOTO 27πGOTO 24π27 PRINT : PRINT "YOU WIMP. AT LEAST BET 1 DOLLAR!": GOSUB 50000π   LOCATE 16, 1: PRINT "                                ": GOTO 23π24 LOCATE 16, 10: PRINT "                                  "π   LOCATE 16, 1: INPUT "WHICH BOX DO YOU WANT TO BET ON --->"; BETNUMπIF BETNUM < 1 OR BETNUM > 5 THEN LOCATE 18, 1: PRINT "BETWEEN 1 AND 5!": GOSUB 50000: LOCATE 18, 1: PRINT "                       ": GOTO 24πCLSπIF BETNUM = 1 THEN Z = AπIF BETNUM = 2 THEN Z = BπIF BETNUM = 3 THEN Z = CπIF BETNUM = 4 THEN Z = DπIF BETNUM = 5 THEN Z = EπLOCATE 24, 30: PRINT "BET : "; STR$(BET); ".00    #"; STR$(BETNUM);πPRINT ".  Odds : "; Z; "to 1."π' TRACK CONSTRUCTIONπCOLOR 4πLINE (0, 0)-(640, 0)πLINE (0, 20)-(640, 20)πLINE (0, 40)-(640, 40)πLINE (0, 60)-(640, 60)πLINE (0, 80)-(640, 80)πLINE (0, 100)-(640, 100)πLINE (600, 0)-(640, 100), 0, BFπLINE (600, 0)-(639, 100), , BπLOCATE 2, 78πCOLOR 15πPRINT "F"πLOCATE 4, 78πPRINT "I"πLOCATE 6, 78πPRINT "N"πLOCATE 8, 78πPRINT "I"πLOCATE 10, 78πPRINT "S"πLOCATE 12, 78πPRINT "H"πLOCATE 2, 72πPRINT "1"πLOCATE 2, 2πPRINT "1"πLOCATE 4, 72πPRINT "2"πLOCATE 4, 2πPRINT "2"πLOCATE 7, 72πPRINT "3"πLOCATE 7, 2πPRINT "3"πLOCATE 9, 72πPRINT "4"πLOCATE 9, 2πPRINT "4"πLOCATE 12, 72πPRINT "5"πLOCATE 12, 2πPRINT "5"πLINE (20, 0)-(20, 100), 4πFOR I = 1 TO 1000: NEXT IπLOCATE 14, 2πPRINT "PRESS A KEY IF READY!"πDOπ kbd$ = INKEY$πLOOP WHILE kbd$ = ""πLINE (0, 101)-(200, 200), 0, BFπLOCATE 14, 2πPRINT "READY?"πLOCATE 14, 2πPLAY "MF O3 L3 C"πSLEEP 1πPRINT "SET?          "πLOCATE 14, 2πPLAY "MF O3 L3 C"πSLEEP 1πPRINT "GO!!!!!!!!!!"πPLAY "MB O5 L3 C"π' CAR'S SPEEDπRANDOMIZE TIMERπA1 = 1πA2 = 1πA3 = 1πA4 = 1πA5 = 1π15 A1 = A1 + INT(RND * 10)πGOTO 30π25 A2 = A2 + INT(RND * 10)πGOTO 40π35 A3 = A3 + INT(RND * 10)πGOTO 50π45 A4 = A4 + INT(RND * 10)πGOTO 60π55 A5 = A5 + INT(RND * 10)πGOTO 70π30 IF A1 = 0 THEN GOTO 15 ELSE GOTO 25π40 IF A2 = 0 THEN GOTO 25 ELSE GOTO 35π50 IF A3 = 0 THEN GOTO 35 ELSE GOTO 45π60 IF A4 = 0 THEN GOTO 45 ELSE GOTO 55π70 IF A5 = 0 THEN GOTO 55 ELSE GOTO 10000ππ10000 ' DRAW CARπLINE (A, 0)-(A + 20, 0), 4πLINE (A1, 5)-(A1 + 20, 15), 2, BFπLINE (A2, 25)-(A2 + 20, 35), 3, BFπLINE (A3, 45)-(A3 + 20, 55), 5, BFπLINE (A4, 65)-(A4 + 20, 75), 6, BFπLINE (A5, 85)-(A5 + 20, 95), 8, BFπIF A1 >= 580 OR A2 >= 580 OR A3 >= 580 OR A4 >= 580 OR A5 >= 580 THEN GOTO 100πLINE (A1, 5)-(A1 + 20, 15), 0, BFπLINE (A2, 25)-(A2 + 20, 35), 0, BFπLINE (A3, 45)-(A3 + 20, 55), 0, BFπLINE (A4, 65)-(A4 + 20, 75), 0, BFπLINE (A5, 85)-(A5 + 20, 95), 0, BFπCOLOR 15πLOCATE 2, 72πPRINT "1"πLOCATE 2, 2πPRINT "1"πLOCATE 4, 72πPRINT "2"πLOCATE 4, 2πPRINT "2"πLOCATE 7, 72πPRINT "3"πLOCATE 7, 2πPRINT "3"πLOCATE 9, 72πPRINT "4"πLOCATE 9, 2πPRINT "4"πLOCATE 12, 72πPRINT "5"πLOCATE 12, 2πPRINT "5"πLINE (20, 0)-(20, 100), 4ππGOTO 15π100 LOCATE 14, 2πPRINT "WE HAVE A WINNER!!!"ππIF A1 > A5 THEN GOTO 2000πGOTO 1π2000 IF A1 < A4 THEN GOTO 1πIF A1 < A3 THEN GOTO 1πIF A1 < A2 THEN GOTO 1πGOTO 200ππ1 IF A2 > A1 THEN GOTO 3000πGOTO 2π3000 IF A2 < A3 THEN GOTO 2πIF A2 < A4 THEN GOTO 2πIF A2 < A5 THEN GOTO 2πGOTO 300ππ2 IF A3 > A1 THEN GOTO 4000πGOTO 3π4000 IF A3 < A2 THEN GOTO 3πIF A3 < A4 THEN GOTO 3πIF A3 < A5 THEN GOTO 3πGOTO 400ππ3 IF A4 > A1 THEN GOTO 5000πGOTO 4π5000 IF A4 < A2 THEN GOTO 4πIF A4 < A3 THEN GOTO 4πIF A4 < A5 THEN GOTO 4πGOTO 500ππ4 GOTO 600ππFOR I = 1 TO 800: NEXT Iπ200 XX$ = "1"πXX = 1πGOTO 1000π300 XX$ = "2"πXX = 2πGOTO 1000π400 XX$ = "3"πXX = 3πGOTO 1000π500 XX$ = "4"πXX = 4πGOTO 1000π600 XX$ = "5"πXX = 5πGOTO 1000π1000 PRINT "THE WINNER IS THE BOX IN LANE "; XX$; "!!!!!!!!!!"πPRINT "DISTANCE OF CAR IN LANE 1="; A1πPRINT "DISTANCE OF CAR IN LANE 2="; A2πPRINT "DISTANCE OF CAR IN LANE 3="; A3; ""πPRINT "DISTANCE OF CAR IN LANE 4="; A4πPRINT "DISTANCE OF CAR IN LANE 5="; A5πIF BETNUM <> XX THEN PRINT : PRINT "YOU LOSE $"; LTRIM$(STR$(BET));πPRINT "!": MONEY = MONEY - BET: GOTO 700πIF BETNUM = 1 THEN BET = BET * AπIF BETNUM = 2 THEN BET = BET * BπIF BETNUM = 3 THEN BET = BET * CπIF BETNUM = 4 THEN BET = BET * DπIF BETNUM = 5 THEN BET = BET * EπPRINT : PRINT "CONGRATULATIONS. YOU HAVE WON $"; LTRIM$(STR$(BET)); "!"πMONEY = MONEY + BETπ700 IF MONEY <= 0 THEN PRINT "UH-OH. IT LOOKS LIKE YOUR BROKE! " + "HA, HA. COME BACK SOME OTHER TIME.     ": ENDπPRINT "ANOTHER RACE?(Y\N)";πDOπ kbd$ = INPUT$(1)π kbd$ = UCASE$(kbd$)π IF kbd$ = "Y" THEN EXIT DOπ IF kbd$ = "N" THEN EXIT DOπ BEEPπLOOPπPRINT kbd$πIF kbd$ = "Y" THEN GOTO 1000000πIF kbd$ = "N" THEN ENDπENDππ' G O S U B   S E C T I O Nππ50000 SLEEP 2: RETURNπ55000 SCREEN 0π      IF ERR = 53 THEN 56000π      PRINT : PRINT "Warning!! Error"; ERR; " occured! Aborting..."π      ENDπ56000 PRINT : PRINT "Warning!! Error"; ERR; " occured! Aborting..."π      ENDππChris Sequeria                 LUNAR LANDER                   QBasic WWW Page @ lookup.com   12-04-95 (00:00)       QB, QBasic, PDS        191  12651    LUNAR.BAS   DEFINT A-Z:DIM SHARED K,S,B&,Z&:V1 'Created by PostIt! 7.2πSUB V1:OPEN "O",1,"LANDER.ZIP",4^6:Z&=9228:?STRING$(50,177);πU"%up()%9%%%7-%tq/IEod+k\VE#%%gS%%%/%%%%qf%sijw%SgfxWfLvFuS3+aih,πU"zxi<cb6hPeClX6S-vNb-c_bU..]j'V<hHT8]oF)X=j_2j7G).NZH3Ba<>jmTLXDπU"L:b%(#[ck(H8Y?rF[?^gf6GWs#8uI/haLwlg9/f%$F1AGNGg'kT:,a:QH?IkE;gπU"FtpJufH]0\<H1RgF+636quQ8OEI2B-54:+WLG+oTu]i'SS[5,5'EvfT.okqwEaCπU"U=wnR\Mh0OE1Ctj>I<H-TU'Og5/?EdI1e<E.l??5Glh=d5e:o(::UeXBW0sPomBπU"6mdD4=Mnb88_Du^)Ce1_^8gq#HvZlG:3\3S=eVe+7f]#GuvZ-po*\ORgbNmH9e2πU"H&d#Hc$?eOn>8DK:*D=R55>P#xSKOQawP,KrOp$5/ogcU[rbem4Wei:1ilmBHhbπU"Q$e$]qd:Sr^W>9UVBO-);o:,[?)lv#3,KY?P00-Sr$a[nJUrm[&KQg+Gk6yM%]&πU"xP1LWK12=6ZEi5z9h0LRiT)Fc8hcU#^hImJGCa60d54=5v(:AD*&2;WLJ5A.-7_πU"(_a&C[x;;U]dhW>2Xg,6;v%c_59=Mq'uMRE.41/8dxDN'L'1#8PL[+F1*Am>2a[πU"cL)$fV^Ui$o><'#sKg8R](ufSdb7/D30:N;i4P^I*g'16gTQO)7qI_m=HN2.-O*πU"BH_B3<:Fk&l?-vTEXmnatK32Co7=RUNv(+'/mkhJ1TK;QCqg*j6jO>+VG2O2:>eπU"129<W5()3(')e)6hlYe.zQRZ23j^mP/2Mum+P;nK#&<Yc?uOqT?c&;Mb>Q(Tkw)πU"-ePxWGW#/3/dFlv473x)w;?1$cWbp\>R*YVu=*g.87j#]5/(1BYE*aJXsCCAmq;πU"Z(hQ4*/<R:QK,4)g[:uE'DDi3]V-0/9KTkVWGf%HY&Q1t#x:[u%'dJFbFEhN3tRπU".yd60a[4LoOlvj0sZcg?un$:??OZHaA6(:-<YU$zJyZGwH:/+jd?Q9)=1_%+#\fπU"]6=Fx_JFa$STC*D&*E5#GFL+qpCg8,6.'4:*dJ54#E^NhrESk:ocNFZih+CO3TJπU"HI):lAhuu>=j_RiF0%'iF3Us*w9Bx]DldM/C2gdj00z12iv-<'TU^l*KIL12l<BπU"7kV'N#rTFi$76[h*hjj/frHHtg'VgcK(R3NL?i8*U(+yS]#('9:^J'lO,lc/X9GπU"hp#qAG$Za<WruaX<dlMV.ye<KfgAhHadLNi;+MW8skbtiPA-=6kO/YGeqF+Akh(πU"OpYnV[KcZ&hT$JT;*h=sq[ZX4cZ.hurlTKrW<&j_YxnR#T\Vlg18XMbq)_3lnQ#πU"#<g.W1#2^rvtW3rZ3j/L?F0Y1]#sOZ;j#Gq>]miK/MLB,,\nUU2]Wak<dQlitUPπU"N85BbueF_>(qnz_KL>V.kWPdi^0H-h#2^KibbT4rc,plL:5Pfjt=tIoA(:]Sub2πU"47tc*LQ0>_vLX_84ZLGV>+<GQ3W;Kj0U5.+_qUbxen.JbG/ajdk&l)UNEQu/wB6πU"L_ysYdnc;r6W0ek^W>.ZHc2iQcKmWmXqULXg+F636ro$tD:*\gql\nmMmm6B>71πU"9gT5qC(uH7T8k2D6Udkh'$-D<5'6J^pcyuR[>yo8;-eY*3Hy%VNlyNMdy6\M(]_πU"?YYy5mQn&Ao7^qH/n^/F_N_)FUZS7jQmG-+tn0mTWUgV2IRm#Ged=VC>J.O*M5TπU"<RkoU75nUf$tnm^+bCZJo=R_H%t<1m:r3\D->-\GeW-)KF_KPG563jWXif&,XaPπU"v)cjV7d+HX1&NJN5S6lv9;uM.w]8sw8rSd#G2yLqn-1FrVX/pFEp$$hbdI&bW.lπU"]Rd:$2we*kNBLlc</M(^V7THIrYg?75g1.oZwd;LqH/SCyY8FZYUNa=b)ne_^BYπU"'QlX_4AZ0kcLX:hgwrT8C$(;rV($B=Aazm(5IoM+f/tnY'Z%<R*KJnCo,LP\d79πU"LCaM4h-O/V'kAT*1#B9]pl[\O.if%UW4gXlrjZIjmXU\6Wa5&'7m?#i3/8Nf,%qπU"Xh\F-]7Pe%-KH>+U:P]&zIEih<c()#l;gaZ9cNqFxHO?ivgSSe'v*KT\?M0m4'=πU"CFm&EU+vg7]j33<qd0szi>+n%v::rk':luEa3/3MAi:YTY^Sl$oRX-<oTYiwVX/πU"C#GEKW<;>Xe-XdaD,ncx,,L]w:CGRlha\E#rVK#Arl1:AQq'qh&'\%Q1vwsi2TnπU"$h/Y]6.(Jh1M0BJ=eOUDh-Ni[+GxlH1d;P5QP>wXayBn^o/iUMaGnH>B*,\YtrXπU".7m)dQ]H6S1iSDhRqId'tN:Y9_ChE.Tuh/t:L&meL/+X.$=CrIAiIozK,MN_m6mπU"0L]&r-ztIKfi$Ju$8.ZV\T635r,d5kn2R&OJt-NO]&[Vc$iAW<-yi',)&17tx*2πU"A2%>lyo>Qm7imvW<&*f='$J3:t0^===X]i(D=5,[+f]eG1QJCe;qT8%6re'DOMWπU"KrDlA9\DU6<'w:6Wa5A>D\#L[c2F?8,x'Uh-OoU3y7:7A/te=ZfvmjxX(s.Qx$(πU"Fz&fr4+fi5GO&XFL-d5fu^aL-M/,et#kqRQ?McE3'd+\4s\W,Yu=$l1Odf4fAl)πU"uTmWbZcX84%L+]pQb.Ndt^_'LDP$3_GP>^h<t&nI_dlVU+anzu>mHeRXa0kyJd9πU"KK(npBX]OgTHC;%^9,bGb#Jx-tfrcY,n]'9wu\N8hmAg>>Z5X6f9826x.iMt\NdπU"mhrPQR(P9v-*=q?.KNA2y<O=PslXMIuihV)4h&zFjtpw3ON'zc]hhq9j]mxo8juπU">-Z^hR<\Idt:\UC%bmWP)&)f4J:baKW59(xr.o\$dtbo$j3O[Pqiq6$.=,9DENdπU"MLa7&NN':dn[a%NNYs-R-od?Yh#?-N<^y'feXOeqr</f,T=Gk6*\4B81#>;k=5EπU"2K.P-90QhR%yUW1P.E,fJTu?$Dwno,vZ=D6(lHigbc:o>ZX:6pA\l-^<6JMLR-BπU"h_NqKHMaD)Ligj)CuOYG2f?+:tILy#2yYWsxF]L.,AqD+yT=W\QO,hkD:c)OuWSπU"PJN,sGcCA-^t7\%Ynj83GG\#Wj5KEeP#a(Oorb+VO_(Qg3:iQQ>>PC+K<njoIVxπU"DKo__V;-HEtQV#FR8d>L?_O9D2uqY.>#6R#ZO6*_^<uDI-o&$AZTtXeABb?6BeuπU"YyX_]mM/c*.m8R.J,5^qX?.AMDayXhhi#6K%(.n3G9Amx^DGoR:O^N?TbWRLK+_πU"(wS[kP?ZhGgr/6zR4^-C49A%\5A2767W;z;Z\b#)ibofi^Hp'>6mD4$,-T]9,jUπU"?O*7jzK/M0fqJ-o3Kd8)dI/V4krAAk3<%/n8TT-_d<>6l+lThWIbx[]R8otj#HhπU"V+Ll\4;'S+QrG21o?Qh8dl\xa_AEsI=B-?tt>t-I0IQ]=Watjqn/VbwaK90w;oYπU"=S5ntRxJB'Cx1>*v%fMrlyboCd^xF*^9c%p&\pbngPUg;Tag'&g_g6lcJ-Q12fOπU"U4pNR#mo.2DysUw&lfGUbq7E[1.<RV*409tEVt;kjQf_Zii<=s:eLC0KuJcjDs*πU"U80($geKsxmHKE.te[n:X&0H'#f^gjEm0_?i[]RN^Wmy+'O&m\4[)XLRr'?wdrtπU"I,?dJ52)\=\ubi+v+9s'aPXREF%2iA9go399RvxKRd\Le)4v*V:dx:sB>;suC_CπU"EYkR1Sel_r(I/[3[p;h]b/$__=7xLE*Y4K41jW=gg6qT45$+6j4K+[^sd#RgB[VπU"8;][XZiBA9E:][W?NBej9zGre-cDVtk.?>&Pg1tDUC/LE##qVJ$JS<$uZf%Fk'hπU"VyXT_ov0B4Z'>1j^E](M]A>l,EAnt1nUwG*XfqChkS3S$Mq>]6U]\uHFBYo8=IdπU"lwjK5y$J0QR>&H-^jkbO]U:_m#0DbrqN<q#IX(Xr:873PrQP3lN)Wd\KsJp/mP3πU"ISW*8Dq%laax+Fb[agbDqaO1+_hMf1yfy0%?\w?kIN['lZL?SIDIw+G\GxdfnMyπU"Jg]Rfnj[k,V*5u#V%Ok8YiQajcp/uE%[omaNNHU=Hu^%BAn5sbfViHBQ]:Da8#zπU"\p_VQnuH05E':7rfJVaI>'hHRoK?W;H+0&j5q854*TWS,l_AYkNL.duFd5-UeuZπU"qnhq(:nl(nsBS7+mo:]4O($UUGsw;S$4S=7pQdUuR'BW&423mxD<ebEj#l]#b#YπU"0$7*[0ofl^LO/v4rtH<l/h3eSN9G2)F^.8w_^'*2q+[jZchGtbtw*5-?cY9#IsgπU"swahBKJ8FK.<Wdr-Qfx^IrK6mjI1<(OjXE:Z<4PJ3^M$67G-L_B]A+L2_j$8?TEπU"rG&xGT)/RkT<b>jE/p3+_[U.F=0'+vx''H1<kpQY%Ema6M_/VJ<\Cf7tYuUKZ,9πU"aR5EjKPcPrRt>R$/git]+QuE8:yjb1%1j:f;ZwgXbj:eV=St<R0&Z:4l<t,lR1zπU"UX6KX=qk]<6I)a[8>kNMGidin6aGTlYlbPD-9=L-&'LC&>AAHC=bN>)q3Iav#5^πU"1k#M\pE#ADXF?F;2pY^Qj]UJrtZ;Qlo%6uGTw6Ix^&:qRhH-IO&)FO68t=4ZxJoπU"cyif,ru\uXLc]NL'#=^Fm_GxCK6>f2I(Az>6?jP,4c9gM&=+TAVYC/2wOL1N>$_πU"[q.3s/re_2<'b&ly$l2Aqs?f]=kF*5W-TKdnfSip)]stMV^^m<qL]TtcgwOS?GWπU"][JF8kMPQ)i#^W6.H5Q1o67Dy))pZth9^1B^FJ2Ad&D,EcSP(iusXlQ[nX'LGOUπU"uVRZfGLerPNs%ru>z#m(5hjXmAplytRH#JVFt$#rbs4U([6[YjO+]iA:U_$l,mIπU"vgu/bj))]P9(r[s3]ATD*,gC*H;5fJG49mg+q,l-4]2>vDKYX0hY?\=%Go'W(L%πU"-tlumvhV%/uf;A-HD=';;eppm*lFWdSxI+HA(lCCKz&(MH6PvU<JRCV\N/RE6tKπU"4HIr/t]^rupJ)rEJr#=$,n[;8aer9-[P*h;4=dQ9_A1FQk#-'D(&29:Wd:$/kaaπU"s?%1^[>1cVeKL9j6V5SWu,&>a&[Vl$^Pq%K<2-$7l7%G2'_i^d5Je:ZW:4ai:BtπU")b4R$#p[gvJ.Nj6ZZkeOA6D_jDABNe/jRT,hb-ERu='$JE9Nl^PEhl4,H/]5s\DπU"GroqwCvnrE#CPzM1&bZlzN2+yvzbB6<llLEy6ZPe24H'W(eu6II5eb,cGAVnjyMπU"Mycw-a+A^W0[Qy-dXB]e<,Xm/Ff)-^d_Cn)Tkblf8G)Egp=Y8Nv>3>m,Gnxp5NtπU"rnkrl-i8^tvO9/02>6?9A?AAoGM-[UE-7+/b6SLqz4t=lU+;040J:B5-._iGhRvπU"wq8\_#9WQSQH=F]U91a6$J\jzs=f96<ArR/GW\p2,4ER(vs<-jvGv&YL[SSCx\gπU"8/_S?,wU3v2.A#&-GmJq])vW6H0VP#2aNU8W3($$_3HwXKXhzMp'r*qon3cqNuvπU"G=TaDhpQj3teS#>N%Q:&70HPc:+(W71?unld?MzFRb.4$Gsp62U#XCxH=/_dXHFπU"CG*NXK$t#5=0nv]u)f&[m]xUG;X[,HE%CpJP8sNlH+:n(f:d3EN=As6PYdnV:_,πU"$>7PX=VD%^WHCfIgkV=d2IsiH(:7/LAr_'S<HE?c,nRuVe8e9,2D+*#GV08YKWmπU"Hq,FruFj$IErnGcblHQI4gMJ&8&T1r3IwFCpd-Ng;2fBJ*zZQVGsF(yH]g[&$>6πU"*%dHgD8em5*#av+IqrH8n8Y14<lgEv(3O$l&te^LK-Ac&3YAfW)#tAf?B\[9BvdπU"t987c(f-4'aS=oP-KsoBLDSfT.jr$Yg<++5no-U:vrr?riMeM'TOB-'n2MV[$bRπU"\i#s(x7h.1#uzp$9$v0nX49#pGRe>$$$a(?9^Jk;ir*orTuAn.6IHE?6vhI_yRnπU"aW4X^/kqqJ0aa.(6eV_lXSZZnA7plR(k:um01htKL-ad=O=2meuOwfBGetTvZF:πU"u]C\5V]D5/fba>gX^Q3+TcB_ZEie^7I-6.dx=fH4bqWqg&4]'C._C+5M?Y\-[2WπU"MWVk7$0aj3=PJP0r^dmQt(DrPC=uTk60-x=$hSm*OT^ue7^WK9HL^6$>kk.s>(TπU"lc5VroV%*3u'[Iw9s_uT-0+9j+o75_waV'Q8-?Wim$Z_,I$bf0r,ptC8.+^x-4sπU"L3cNm[l%5YAjqQfP9*B?VZ=:)b&;e8mh\:k'(ZKUu;UGI&\pJ*0W>_]jRA6]Ov(πU"0O:75wVI:93lS4U\EM0ho(s'mGLi*+_qhFZwt)(:/_I+F(<=<.K4SR6M/Ip]y0FπU"_l->?;*T$howJQ6:$7i-zTMLSI^NELiYLfAI'tsATFlQ4a4)BDmhd&iHiom\N_#πU"dn4x96&K7J.b6/w*:ei7Sm?</r\j,j%E3oHZmeEE$Tg.kmag3?n8rp,$9:t4ZNZπU"rx<Ky<V'A=YTl91AQQ%k[&[>PnxOgOKfFA\9s=k'](Xr)Cfc>>o=TAb,ouA7EdYπU"q\9&<T(*aX4IBj2]0]Mf/hYT;u5f:6B#\kIbZ:*&PnV5YTDO57Q87[&*YF+2qsdπU"41oe.[KjS=#u8gf$SCql-LyAZMaC<;NZU(=iWUq<n0Au6]E5L1$$4Cb#aOAb[e?πU"oCeN2M5Tdo<I:jhq&\'F##46BGZU<3=LPiTEVBC;_pRJu0fc7m0jhGNQ>Na:pRlπU"6V>A(?_X>0*5Hd=&,yqT:FLFv)vt?dmX&]h-Ee-hbdiPmD%oUA(QAh[[tP:_j3vπU"s,SM7fv.G(b-pnb=Gs\uZ.h#x\uq%s)R1hX,^TA=[6S>]f\WJ(JV,HYXFhR5>4>πU"a)Q[,T>8J%QKbu$0xiadCWL%JfQCCCT'Y_&E81*&q_zZq/wvvpSOnc&Fhcm-c7,πU"Z;EefIQ$ltyg>bh\M>u2\/<Fwn.$p_]lemqdb4UvL.PP.b?VVstOleR#Q*IY$ruπU"44sA44uu;pXTei]eygZs[w\(\PMK+=VzX7'Uo+c6g9i#e,?-CC8O/>(0BKsn7v;πU"4#/8kTEN-ZfZJ)B?n*ZBAeu6VGvsWX(KH+JG+s$siks]ZN5Ju>QOew_lqim:Mz,πU"I'VPN=5APddw4(FC,3=T$(gOtIi*_O/k%4?L+A0E(v9R[4JW(PJTH&E3apmo[[$πU"K#j=SCvprd1ysd%_jnhL=1)DOc2:22$MAt9wI,I_t^:W'-8*8%dPU+FnqLZm'klπU";?BC#&Rm\c)Zv<l2Dw*<rrai<'mUn+MUY5iAgX6p8dVc+wGMn4O<.,2$0&ft$a>πU"l)k<PT$.76uo+54SqW:ZG&f4s#C,(sfpW93g'l&?26#UKdVrF0=kB>yI*vt79ioπU"(AdbKPW303:l7I^;ykcP%EXwKesSKe04#m:aFfG^4b,Jf]c-TC[.Wpo,X]mE^-PπU"yfL:_=4a#%n8=7q?J:Pbuv/^pP$hk(k4ZhV8Opo6K&\/#z-0CZyIed?Xh5oJKRaπU"x>U6kRLIjt$*eEZ$YKhjN,ta/^=N&3fTWQXKNd>'FaqlII/[]V1D(Q(uG>SIAaQπU"J=CU3=1;#VGI:HhW)mk.wCV<Uj4jYp1D]a7V--D/JK2(aAD\wq#;SC173Jr9rn+πU"<_fQ_P:ptQSZvR6,+*hFVDwi*gWg7Dxh4Lh9VlIgRm3=cl;stiGGIH^AEw]pm'SπU"]j4rj6JChVY'1o:^#h#x6>\Q'&d6t0<##Ga%;XHQaeJAe-Q[J1U4lhbbt.H)1t9πU"O1Oc.B4L=z1vu5jVDHY$SUE8BnK?x;qDA)CdqG+0XKX^pa)V62tC7[Y(_&:nG#[πU"RN\O:mPs=A8$p'DqStuVl88zJ)i6Rq<CdEW[.p,hJ_PeG]*g[\Y2Wrq=h2+jvdTπU"F$eTJM7$=n?^TF^Cm$M0Q6iY.n^UK3+U8N:#ct=eb^Dw>=^f\%H$0(8&\<pt9NDπU"VkVP0R6F4seAY8^&0gL>vfNA('ex$>V%xt<=IKgCuCubF\-cW)0^_/$Oou2%Wj=πU"qkzPttrkd^)z=OQL\xe+#B31kL-=g60++bG\F$Tg)n02zo#Aun<ks70do7:I^h>πU"O/I1g2=]\kvP5AWl]NUwpr\pZ5BUq6j/%B'Rb?chWH)QE-#3#\pAT4CFrOh3(S2πU"'[(g<26sV1t71V.pxWGN]kK6H9+w'(&8]\o:\lEkff<JT1BI*g?F[KW3f%%XFt?πU"K&P=FICu_99%Mh1PuLwQL7KnCU8gGIR9^RNZo]n$uZUEaEm+(aUUiP0]/h*Ar>%πU"&SvMae.-%tOAqIi.),6u,n:<F_3E5pMbEE2%U/Oy[tHn5&0H4lJ%R2_i/kn^4MiπU"qkm08=9.%+]<c+421#zK&.#r[e[[HJ*v\OEnv?AO+)+b)JW2B47z<Y#94,W/rY_πU"qZ:/MD/Idj<'s'(G\Lvg6_j]Vw[fC9vS:UbPYukmFxeh%shEW6,o*YL4N*^G73^πU"V40M^?.:L1Uxzr,PckIeQUdCN3A1C#sX[XIs_Q.D-9tY6Npxu?,h#Mj__FuG7<gπU"Zl78tUOqiNrYhJpzltiw<NhS[]lfazp[$Kqj.JU.FL-07&<k6ugasdwNTXotTI=πU"q)If[m;BjB$zb2q251dpNR8369M/ZKpiZ0$efpXjDRtuDG6r4IJ:nR0h[,4p_(oπU"LoK;bYzB]zMvl:L9/nNj,0cS5L+$C4Yyq%s^hNiJLKkzI/pKG\4'%8)lfM\d=V.πU"1H_0KeuNX;3QUB]u\O8Gnd593zZ_\HR:*^viUoUD<i;s=pe9S8<U-tk:Pf4UU$IπU"MvKR84K9F85uK[[\)v-C)Zq=FgLN\2<*B?G8FrtcH%D98Vsp4qYy8T^;Vy8o<1PπU"C>jZAxHQ6:$.lkNI,DbMOhJ4)O2aM5.3EuL8*pXu:ca?>p$e3_o#Rz&2Wbq09ICπU"qi];*%0_4j#nVK=Ia#YxhHQOU=&[5xjMKVH+OpWGoN+c-U1>R;^C4p=1'tL,#oQπU"Pfmw9or53^nGBsa[j/kuWU3&4g188UI3Vpp9??jeFRsv4?P6SP?$Z,$&^<o'(O]πU"1H\/Z)x;&JLF(ziyj#j>$w+/V3Q9Z0_Q<>xl$re>XN9rkdV36&#s43f^=d'BH\LπU"6R_glvpiXaMqd2\f=l3%Z_R.h2doBeC1q=6OkT'^7p0VU/r_NlBsx%QJ4T[pW?QπU"rY-9ri,T\FclB1z//.EmT,;(ZMYJ:?U;^VqmCx+W3bXZm>>-E:n6iJ_C+:LFbTQπU"G'e5KNQnJMGrQZ*\cT\I,:mS(gBJKIxkR]nh2OraC\j^,>P2&e>8#'C/4>KkU:FπU"iFRwP-Y<j_eY\)o#\0L])/\V.YK_=ZWvOW?:eHpF9k31.mC%\'?\rf2HR&AgE4WπU"Mm6HB4WDtt[zDi-qy&86az#[T9a21]nh8bM2+Q(**h;h?=Y(=+e39d&iwYGIO0:πU"ybR^cT*>.FXlsQsA6_RbOM$XqZ5ed^[.pAL(iDg468c\\47_GPGDc%Z8YuS%W::πU"hL_I)yYZC,8>ejf5BZn#>]B&qQ;8\fN1ZC'yNTF>kEIWE:F10rb]sbVdgYEJ[9HπU"JvX52E305s'7bi[Ic9O%x)<7^$gb*bi^XG('K)D,\oDIHUat*(=)]axXAHQ.rKAπU"]A-K2J,D56mZxi6&TB#:jR->:U.^pW,cY#$3)InuTSC0JGbmydaAr.oVfq8l_O;πU"Y%VHgdbF/L05:s$.uJJp]bKrr<m/B1[Hcll%+9?F\=[TYa#W]lx/^?T3ZL%C<dbπU"+kj'ZQvkKde3U[YR-v3<^7Zb&u\P:gmiqQgixG,*+wCkA]'^]n5ZsX+>akni^h#πU"_(=$=C/yhxNoKL(-m:$QCij'[(n1^a.u3MmafL9M6);DtV4>oVhn1C63[T3(Hj8πU"LOU1-.rH7k%07K-.B/KL6>474ar/7J/P#,_Z^^n]m=WVoA9zl=Nf\oMZgM09WN3πU"-a<_0Vez96]w3M[5t#Tu9gMt%%]DW\I$X?=%U$2KN$&;Jc(gC^,Ynr765oth\vtπU"w\6INE:2ORv75/TZH'=:Uhh9NSO9>]Bc-o66,$b+W(tiE''-eoOYTu+po2mg;KaπU"yH*hfl/%)?oJ5HZ<*3$&1U;vB_eI7la+lst]pHg.-$mAKJ*.h-&<M-4x*cV1MG6πU"'YRJirA5\47tz;Vs1ft;VG4:x[S'-1>a\ZB7]Qj]no\43cYbTGGgvX<*c*4Q&WTπU"QV)nLSk*]v4-fAnWV1kF*:HqH6wKOTYr/-pkiIn]g/S]^]-Yc?.,^(frHg8N4(sπU"*cA5Mr-J[3rr(YPUh<B*b_8IAV6t0/IQJZ6l1b'%]A(#-Tc+aK)o=_YcJQy&j>\πU"eAc9b-l]tTzQWU9-jT]K2)T*r6.=Ev[%lj3O>A]77cpQdJb/3/X'bediljip-eBπU"-lK/.n[F*V-J3JC2PxrUO)(;']608RP0sp(4?*IgG,ZLJZEpKHCUF:^JwuTP<REπU"*4GM%d2B2%U_M<(pYEnY9kx?D^*e;Cwi4,'h=Vp+x<lG\^WowH^tlAsxYnA8<=GπU"&p$qA*7W?:uE+k5eix%2up(%)9%%#%-%Y)s\DMBM?0<#%%%.%'%%/%%%%q%fsijπU"%wSxu=wVHV(3TE1++YdC69,GA;Fr,Hbcjr?0FHHT)RtuDLr[bb:rovm=(ma[ho>πU"5-oqgu$t?_UA1$.:Y%?CY>HN05Z(SWm69ihAqP'ot_=&%5'?NXL^\qinjskUp/EπU"]#(4:OoF'OMluT&X8up%()9%%%%-%/6D>?*aI>3%['%%%,+%%%0%%%%ijkf%zqyπU"S[ufq6PctAie?9Sp9([N=gir'j8Qf>p^=;=.H?/a6rXr(PehSnMp\7,\p35YeurπU"Awk-tPtnpDCxRUZnSFrpzT0Z:v0R<4y_xkJN+^f7T>7Cz\s%PtKyCT)OX$$d,#dπU"3%dDyb96N*R/r&&>\&&G5:&6PCz7JIN+u9*/2b':;J-jXb-[*7]#Xa>3$G[l\GDπU"4jX%hY<'u)f.0:&QA&Q2)P%-w-7C-u5[CFWEGeUESY(.Q[)m45a8%5-'f,?t0.%πU"'fE-()PE5()Qe5%-'fEd-)Pw=V:&h)&CkJFOIC4.MjB98r-nv(<Du0bxRbpLxdjπU"llQPiQ8.Y+La?SLcob,wV.8hLX5BP>SikkF8DheSGMX>L.lDhu\nFXiosDve>$3πU"A/76+r$x-i?NMm]x(eZ8NK)M:0ti&(.9xJ>XA9bL7GH]h^N).gb)<#7sIc[IAmAπU"OnQ$_G$)I0Of;[S)gS6..(7II#)Iaa8?FZiRgn;P2SkSB%.>.p[7;IE(mWn=A$UπU"Ep[lge;IH.&ItBjU3C$D0^6-)sb2.70fg0B)1Avh#)31qTTE-?sbCKmPLAunhF?πU".w(ZW*>26T\rcvGUo*FlG5^qH4OtD0fHKmg0nhIMrZ,>XPG'KunBW[NmYMyoZ]LπU"x,aw<56ebNkKxxEnlLxgwUl;Vv0xF*)UIFA;WLNJNrJNJxN8>v/<omR>f,x5H&hπU"BX$h1EnRFF,(5eFE8d%4up&%'9%9%%%%-F%tqI(Eodk'\VE%.%gS%%%/%%%%%%%πU"%%&%E%%%%%%%%%q%fsij%wSgf%xup&%'9%9%%%%-L%Ys\7DMM?(0<%%(%.'%%%/πU"%%%%%%%%%%%E#%%%(%E%%q%fsij%wSxu%wup&%'9%9%%%%-C%6D>4?aI>%3['%%πU"%,+%%%0%%%%%%%%%%%E[%%%g%E%%i%jkfz%qySu%fqup%*+%%%%%(%.(%x%%%%rπU"H%%%%%πEND SUBπCLOSE:IF S=185AND B&=Z&THEN?" :) Ok!"ELSE?" :( Bad!πSUB U(A$):FOR A=1TO LEN(A$):C=ASC(MID$(A$,A))-37:IF C<0THEN C=91+C*32πIF K<4THEN K=C+243ELSE?#1,CHR$(C+(K MOD 3)*86);:K=K\3:B&=B&+1πS=(S+C)AND 255:NEXT:LOCATE,1:?STRING$(B&*50\Z&,219);:END SUBπKenneth Green                  MISSILE                        [e-mail]           03-31-96 (00:08)       QB, QBasic, PDS        82   3265     MISSILE.BAS 1 REM                          MISSILEπ2 REM                    By Kenneth Greenπ3 REM             Go click on Run above and then start.π4 REMπ5 REMπ6 REMπ7 REMπ8 REM --------------------Program Below--------------------------------------π9 x1 = 0: x2 = 0π10 CLS : SCREEN 0π15 tr = 1π20 PRINT "                   MISSILE"π25 PRINT "                   -------"π30 PRINT : PRINT : PRINT : PRINT "By Kenneth Green"π35 PRINT : PRINT : PRINT "This game lets you type a one": PRINT "number coordinate to lock on and destroy"π36 PRINT "your enemy."π38 PRINT "You can have as many tries as you want,": PRINT "it says your tries after you win."π39 PRINT "To end the game, type 0 as your": PRINT "coordinate.": PRINT "The enemy is in a different": PRINT "spot every time!"π40 INPUT "Press <Enter> to start this game."; go$π45 RANDOMIZE TIMERπ50 x1 = RND(1) * 10π55 x2 = RND(1) * 10π60 x3 = x2 * x1 + 130π70 x4 = RND * 200π80 IF x4 < 120 THEN 70π99 SCREEN 1π100 LINE (100, 185)-(109, 150), , BF: REM ***MOUNTAIN***π105 LINE (50, 185)-(60, 170), , B: REM ****YOU****π107 LOCATE 5, 5: PRINT "YOU"π135 LOCATE 5, 20: PRINT "ENEMY"π140 LINE (x3, 180)-(x3 + 5, 185), , B: REM ****ENEMY****π142 LINE (x4, 180)-(x4 + 5, 185), , B: REM ***ENEMY 2***π143 LINE (0, 185)-(300, 185)π145 IF tr = 7 THEN 700π150 LOCATE 1, 1: INPUT "Number between 1 and 300, or 0 to end:"; gπ155 IF g = 0 THEN 520π156 FOR tn = 10 TO 46 STEP 2π160 LINE (52, 183)-((g / 2) + 55, 80)π163 SOUND 100 + tn, 1π165 FOR tym = 1 TO 500: NEXT tymπ166 LINE ((g / 2) + 55, 80)-(g + 3, 185)π170 LINE (g + 2, 180)-(g + 3, 184), , BFπ175 NEXT tnπ180 IF g = x3 THEN 500π190 IF g < x3 + 3 AND g > x3 - 3 THEN 500π191 IF g < x4 + 3 AND g > x4 - 3 THEN 500π195 IF g > 49 AND g < 56 THEN 600π200 LOCATE 2, 1: PRINT "Missed"π202 tr = tr + 1π205 FOR tm = 1 TO 60000: NEXT tmπ206 LOCATE 2, 1: PRINT "      "π210 SCREEN 2: GOTO 99π500 FOR ex = 1 TO 9: CIRCLE (g + 2, 184), ex: SOUND 100, 1: FOR ti = 1 TO 5000: NEXT ti: NEXT exπ505 FOR m = 1 TO 95000: NEXT mπ506 SCREEN 0π510 PRINT "YOU WON. You took "; tr;π515 IF tr = 1 THEN PRINT "try!"π517 IF tr > 1 THEN PRINT "tries."π518 IF tr = 1 THEN PRINT "You are ranked General."π519 IF tr = 2 THEN PRINT "You are ranked Leutenant Commander."π520 IF tr = 3 THEN PRINT "You are ranked First Leutenant."π521 IF tr = 4 THEN PRINT "You are ranked Sargent."π522 IF tr = 5 THEN PRINT "You are ranked Captain."π523 IF tr = 6 THEN PRINT "You are ranked Cadet."π539 INPUT "Do you want to play again(Y/N)"; ag$π530 IF ag$ = "Y" OR ag$ = "y" OR ag$ = "YES" OR ag$ = "Yes" OR ag$ = "yes" THEN 10π550 ENDπ600 FOR ep = 1 TO 8: CIRCLE (53, 182), ep: SOUND 100, 1: FOR ty = 1 TO 7000: NEXT ty: NEXT epπ605 FOR tym = 1 TO 80000: NEXT tymπ606 SCREEN 0π610 PRINT "You destroyed yourself."π620 PRINT : PRINT : PRINTπ630 INPUT "Again(Y/N)"; an$π640 IF an$ = "y" OR an$ = "yes" OR an$ = "YES" OR an$ = "Y" THEN 10π650 ENDπ700 LINE (x3, 180)-(x3 - 55, 50): LINE (x3 - 55, 50)-(55, 180)π710 LINE (x4, 180)-(x4 - 55, 50): LINE (x4 - 55, 50)-(55, 180)π720 FOR c3 = 1 TO 25: SOUND c3 + 100, 1π730 FOR tm = 1 TO 200: NEXT tm: CIRCLE (55, 180), c3: NEXT c3π740 LOCATE 3, 10: PRINT "The enemies have destroyed your base!"π750 GOTO 539ππKenneth Green                  TANK!!!                        [e-mail]           04-01-96 (00:08)       QB, QBasic, PDS        66   4282     TANKWAR.BAS DEFINT A-Z:DIM SHARED K,S,B&,Z&:V1 'Created by PostIt! 7.2πSUB V1:OPEN "O",1,"TANK.ZIP",4^6:Z&=2934:?STRING$(50,177);πU"%up()%9%%%I-%L*&PEA=8Q0Z-%%%vC%%%-%%%%yf%spSgIfxt(;<B[]O7wmyEuVπU"C=W'aUa)[-Q#2g;y=\?'Z=3];B8ac+(0[nrg/O'MUNPNce;KD+5K2dKWJQnL>9,πU"xN7/:su\.Ui0QVsY7qpRr8K$orqaLe\Yp(JjU[o:\X\UCopd[E<-_]2v_]F/mi_πU"3SU.UCk><Z\aHGEb*>0=&efB':ch9_IR#JIPrnrbFPmjJKmI=U>7hR)&>t8-#tLπU"viZ=h\qm:OZay*7\Tx'q?kv8g3Y+f.Fgf#,DDHr2qTjJNg<=mm_YTju,2(X##\>πU"b)YY2*IQy3?Pwn+-VakH;=>#r%bAK.nC6]4)o:bH+JAZG_cR-nRi?K461sMj17QπU"yxZb<[DP#+Qh;my$*%abcdW'0/kdhHV%mD;i$Rq8xMhKIQ>JAsa)Rzn<:NIP\\kπU"jv0Kc6404,#KQ)h(&q;qFaM'=oc8QXtO)MEVaFz<^1o(:[N:D_ZVlVplBO,$^^gπU"gpDZh,EF9&iWiL/STN?f+2>-fU;JLRQf$*An-k5edD&w]/:U[gKN20f0;cUj:c'πU")Ifc?bj\3,=Kajc[kR$^CTYPFY[DA/oRp;*>3Fmy,/mdjYVjn,=b2Z>^VOEd#1#πU"O\c^>;pj9d(][Yv\26OmOqV9&ExHOg)16]IhX0UdR:r:#=AoYK.qZF82iSn6\'fπU"9WnvU</_nxBfdxP+.nPvt]Vw<f&0T[9*VxL+9R*PMY?UTBc-.KvP6%0jgu&Qh&-πU")Wow?4BM_rWYUTTwc.m5zOI$tFMgp2%'>bRw$09>t\&9nOP_m9&.TX[/i8gAaUjπU"aqQ&MA:_OBk0[u/7b_Y1>/J15DDDF=L(2vD$mU?p3A8-_sga.pB<pfP*RYc<y4iπU"pZ2U$*w'=FYR*9Y'E%E1^ZL*vWO^=1(Z2<'O0=i_lWO,zgEvF=[J?AfkIX,s&K*πU"2UQz$1eQ6-2)o3*LnF_w5_q['j2B6?Y#XERiwF]7M9_=-AQ:Ed#f*moa>c2[;^vπU"e18MX&ER]PeJrLrSTe3aXsK1<j?.F_?X<O0]k)l1,*hxaol_RQq9%9T07ShBO1&πU"t3O7Y6>];)Nqm=CfMSw*J<%S:r9H?CkYz&mqu\SXfvPq<1Pr,WV>*a:zV$vm?f]πU"wbz,c1ZhZ1S8Mqd]^b\Zlo8eI'3k8<5gnpDMBk2L=V\&&$J6OKrFg^Q)sl?<r%FπU"Kfq,M:yMB[,ZH9=9]q?;JMc-=]HxT47YK(&SvDlBE,PZeI;=Pb6.S$*fMMgF)/SπU"QsX>E\:=ERh7i-WcE1X_F;Z62^-5Z.HT?.^$/RC,FcZa7PZe(5-L>I.lZT/Q[#uπU"VJi:)S$,D?Nd7x?XBF28q1?1fo+K<MSjF.Ocy_wts>U>9B?Iy&KhJ[k0Yp](Y]\πU"h5^eh=gs\76FEY^x\kDp?*;1OYch3MysnR'1h7mL/AaCImCa)_(eAneiEQUlhDBπU"Mle*[%RM0TQAo\=^6n5CF5iUM.J2=S#iQ8KOpO_#.l/QmChul61cC%U\=cT:,R]πU"C]$iQNqqPt90=rT^e9+A$)FZ5=:z%AtJ38y)CA>qC*N\#m_hmpA+CIVT#/33_43πU"D+P,r*FdU=#z2[&NCs3%e\Zvb[is_M78apvbXO=aLtaUFDu5Xx^SXMK)CsL6IWoπU":nQ)#VA4)Z5WYs<uM_T.,ORebEy7==NOjhu;OBgj8u8qAF,l44L?Or:H^K2fC;eπU"a_v9Er[3>FrC4*(xk?=d\'s>=]#8fi.gZD[(9=d3=]Dtl4OX;c3lBdYSu.DN;z6πU"lr%'$ft'0R.6G\uitng,G%9cxv/c\S25+&u'ni/0K7Vj8Q_(vOOor$OF>F&l0$dπU"EHduP)G(_8,u/+3p(SZfmO;0%V=9W4eL*:)coOE'%]HnTLQ9jA45lEFl(V\jHk]πU"O)4$T.U)h8$e=:Kj55kY)(Ql)(q)Han4s*I2b-b/I:6klhn9)WTdyu7g$MCcg-7πU"QJbu+'r4c,k0eq=.0ciBqlOjIqv..$?.0ugIY$ko$OC^8s+]5E^,%MoSN&:gp#QπU"=lE,5NoB#n6i_E54Z[EG6=$kL6463KB>0v/fp<tO[9:JqBOV1CH\$30i[*a$]]YπU"gr58dhq,Fe9OtV$4>F5+$uKQ\rJhbION0(LV%3.USGH2pf]2pC2?]6<J-(]73gwπU"uH9)XtcdPKY99JjUqI'YoK'YqAcPCPhYI]SYP6A;w]\<[2BU$g\gEAP](cL-xp6πU"DpV5$(B_bYG$'CYr+W6YL#_>klKS)M=4CS9O2/MyQ%,zvN\y7fIzm%%gF7_81lTπU";z864XLP&1b8r/3TK4T(y%+o&78/t8+Q5;+:d\BD3iRr6i-1g>gKl]g,=*5S7r?πU"vsZeg;fOuInx1Tn40]w10;.[lip;2bUn0uonYT;ueHR\<kCsNa_Lg;<t^AF-*?BπU"LaF/r?oP)5,Xsbw9=$Te'jpoHCt+(is;1FDL;I#1-87(QcJ=.JCAGYzmUbmg$WwπU"%Y<ZX>LBY^#kL523Yzg\vVLGLKDNqZ_g,89ck'B?sKFbiA>DpPm05usPEjii5OhπU"]:a\gdO,_m^vGrmf+V90:gk$\I(4r2YaGGa.aTU)fTr+W>m=nPp>c45?%7g.5F8πU"J9b14dWaQL[XOB;H/$9&-Zfg4PepCr$+,65fx).h0Rc.vo2P#Yuse$ftw<QJhFDπU"3zw_?e6h53+,xu6oWB5GxURYG:[uPPYM)pqJNY+o)*t<F;5T;IfJ;PO8/oEWQQSπU"0109VRSwB/o79[>3lXB_sc,).E<t(0s'Yo1sNIYBT+QS#_->W:_l>CpLfvaC3/,πU"XC?/(XC?/(XC?J(XCY8dh0L\(_+uUY(wn_Pz8/$vXw6.TvyoAqysqFy.8t)ylMzπU"Kfix9%Lozs>cq\eM-XcMF):DWFl\IT$g7yuMwgKo9Xe,#2yH+b+csDu%p()9%%%πU"%-L%[aPgEwhH&S^%%%%)5%%%*%%%%yiSmvlfK&z2%E79):0\dv;n),4-)=F:i0ZπU"[fqD)zc*%_&cNsam6,mim:LLQCvN2<ol&H3mNJ%,G''u%p()9%%%%-L%uaPCEh-πU"I%wU%%%%)5%%%*%%%%yqSmvlfK'*.%Em5):#uCeCw'7Wx8J\iGk'B\^S&)4%Sm=πU",Xmo2OK$rGr7s,Mw4%&dqup%()9%%%%-%3&aPEpM_\1%U%%%%)5%%%*%%%%ywSvπU"XlfKp%2%E1jj:UBU=Zrg11(TEqWYWrULMk2oE%Y<u3aOhOyVvii73NP'x&%t%3uπU"p(%)9%%[%-%-_aPEU>[_)W%%%%)%5%%*%%%%y%zSvl?fD*.%%F9*sf*+dQCw-4eπU"5L1w16kX[?RO8+oULjPlx\f%tMdH??h(vt3w&M%&yqup%&'9%%9%%%I-%L*&PEAπU"=8Q0Z-%%%vC%%%-%%%%%%%%%&%%E%%%%%%%%%yfsp%Sgfx%up&'%9%9%%%%-%2[πU"aPEVwhHS%^%%%%)5%%%*%%%%%%%%%%%E%%%%,.%%%yi%Svlu%p&'9%%9%%#%-%uπU"DaPEh(-IwU%%%%)%5%%*%%%%%%%%%%%%E%%(%2.%%%yqS%vlup%&'9%%9%%%R-%πU"&aAPEM_-\1U%%%%)5%%%*%%%%%%%%%%%%E%%%'/.%%%ywSv%lup&%'9%9%%%%-OπU"%-aPjEU[_')W%%%%)5%%%*%%%%%%%%%%%E%%%%.%/%%y%zSvl%up*+%%%%%%*%*πU"%%'&%%&-/%%%%%πEND SUBπCLOSE:IF S=184AND B&=Z&THEN?" :) Ok!"ELSE?" :( Bad!πSUB U(A$):FOR A=1TO LEN(A$):C=ASC(MID$(A$,A))-37:IF C<0THEN C=91+C*32πIF K<4THEN K=C+243ELSE?#1,CHR$(C+(K MOD 3)*86);:K=K\3:B&=B&+1πS=(S+C)AND 255:NEXT:LOCATE,1:?STRING$(B&*50\Z&,219);:END SUBπMike Hulme                     TRY - LIKE TETRIS              pages.prodigy.com/gamersp      04-06-96 (00:00)       QB, QBasic, PDS        272  13003    TRY.BAS     '[----------------- PRODUCT OF MAVERICK PROGRAMMING ------------------]π'  I call this game TRY...π'   Slogan: Sick of TETRIS?  Tri to beat try.π'   Recommended Strategy: WHEN I FIND ONE, I'LL TELL YAπ' DIRECTIONS:π'  1. Make THREE in a row (vertically or horizontally) of the same colorπ'     for a match.π'  2. Get three matches in the bottom zone to advance to next level.π'  3. Use left and right arrow keys only...not up/down.π'  4. Green Bonus block: GOOD & BAD!π'     a. Destroys surrounding blocks in top zone (PROBABLY good)π'     b. Changes all the block colors in the bottom zone (PROBABLY bad)π'*NOTES*π' 1. Speed increases with level...π' 2. "Fall lines": every time you reach this number of matches,π'    the floor of one column drops out and the first 3 rows fallπ'    into bottom zone.π' 3. Total matches are displayed on the left in KILLED. *When 2π'    kill columns are filled, you're score increases by A LOT!π' 4. Green blocks are less common than red blocks, which are less commonπ'    than blue blocks, which are less common than purple blocks.  Thisπ'    is important to know, because a RED match gives a better score thanπ'    a BLUE or PURPLE match, get it????π' Look for TRYTOO and TRYTRYTRY, coming soon...π'                                   (Get the HULMER in these names?)π'π'π' I'll shut up now, enjoy...                    <--[ MIKE HULME ]-->πSCREEN 12: CLS : WIDTH 80, 30ππDIM SHARED B1%(70), B2%(70), B3%(70), B4%(70)πDIM SHARED P(12, 11), L(12, 11)πDIM Drop%(1000), Spr%(1000)πPALETTE 14, 0πBlocks:πLINE (0, 0)-(15, 15), 14, BF: LINE (1, 1)-(14, 14), 13, BFπLINE (3, 3)-(12, 12), 5, BF: LINE (7, 7)-(8, 8), 15, BFπLINE (6, 6)-(9, 9), 13, B: GET (0, 0)-(15, 15), B1%πLINE (0, 0)-(15, 15), 14, BF: LINE (1, 1)-(14, 14), 9, BFπLINE (3, 3)-(12, 12), 1, BF: LINE (7, 7)-(8, 8), 15, BFπLINE (6, 6)-(9, 9), 9, B: GET (0, 0)-(15, 15), B2%πLINE (0, 0)-(15, 15), 14, BF: LINE (1, 1)-(14, 14), 12, BFπLINE (3, 3)-(12, 12), 4, BF: LINE (7, 7)-(8, 8), 15, BFπLINE (6, 6)-(9, 9), 12, B: GET (0, 0)-(15, 15), B3%πLINE (0, 0)-(15, 15), 14, BF: LINE (1, 1)-(14, 14), 10, BFπLINE (3, 3)-(12, 12), 2, BF: LINE (7, 7)-(8, 8), 3, BFπLINE (6, 6)-(9, 9), 10, B: GET (0, 0)-(15, 15), B4%πSPD = 10: PRY = 85: BLE = 85: RED = 85: PRX = 2: BLX = 32: RDX = 62πCLS : LOCATE 27, 25: COLOR 10: PRINT "*": SLEEP 1πLOCATE 27, 23: COLOR 9: PRINT "R": LOCATE 27, 27: COLOR 1: PRINT "R"πLOCATE 28, 25: COLOR 9: PRINT "R": SLEEP 1πLOCATE 27, 22: COLOR 13: PRINT "T": LOCATE 27, 26: COLOR 5: PRINT "T"πLOCATE 28, 24: COLOR 5: PRINT "T": SLEEP 1πLOCATE 27, 24: COLOR 4: PRINT "Y": LOCATE 27, 28: COLOR 12: PRINT "Y"πLOCATE 28, 26: COLOR 12: PRINT "Y": SLEEP 1π4 LINE (100, 60)-(280, 400), 0, BF: CALL Arena: RANDOMIZE TIMERπFOR A = 0 TO 12: FOR B = 0 TO 11: P(A, B) = 0: L(A, B) = 0: NEXT B, AπR = INT(RND * 3) + 1: Y = 48: X = 190: SPD = SPD - 1: LVL = LVL + 1: FLL = INT(RND * 0) + 1: TMTH = 0: BM = 0πFOR ST = 1 TO 9 + LVLπM = INT(RND * 11)πH = INT(RND * 4) + 8πC = INT(RND * 3) + 1πIF C = 1 THEN PUT (M * 15 + 100, H * 15 + 48), B1%, PSETπIF C = 2 THEN PUT (M * 15 + 100, H * 15 + 48), B2%, PSETπIF C = 3 THEN PUT (M * 15 + 100, H * 15 + 48), B3%, PSETπP(M, H) = CπIF AA = 1 THENπIF C = 1 THEN PUT (M * 15 + 100, H * 15 + 220), B1%, PSETπIF C = 2 THEN PUT (M * 15 + 100, H * 15 + 220), B2%, PSETπIF C = 3 THEN PUT (M * 15 + 100, H * 15 + 220), B3%, PSETπL(M, H) = CπEND IFπIF AA = 0 THEN AA = 1 ELSE AA = 0πNEXT STπCOLOR 15: LOCATE 1, 1: PRINT "Press SPACEBAR to start...": BEEP: SLEEPπLOCATE 1, 1: PRINT "                          "πFOR II = 1 TO 300: COLOR 15: NEXT IIπ3 DOπKP$ = INKEY$π1 SELECT CASE KP$πCASE CHR$(0) + CHR$(75)πC = (X - 100) / 15 - 1: D = (Y - 48) / 15πIF C = -1 THEN C = 0πIF P(C, D) = 1 THEN GOTO 3πIF P(C, D) = 2 THEN GOTO 3πIF P(C, D) = 3 THEN GOTO 3πLINE (X, Y)-(X + 15, Y + 15), 0, BF: IF X > 100 THEN X = X - 15πSCR = SCR - 5πCASE CHR$(0) + CHR$(77)πC = (X - 100) / 15 + 1: D = (Y - 48) / 15πIF D = 12 THEN D = 11πIF P(C, D) = 1 THEN GOTO 3πIF P(C, D) = 2 THEN GOTO 3πIF P(C, D) = 3 THEN GOTO 3πLINE (X, Y)-(X + 15, Y + 15), 0, BF: IF X < 265 THEN X = X + 15πSCR = SCR - 5πEND SELECTπIF R = 1 THEN PUT (X, Y), B1%, PSETππIF R = 2 THEN PUT (X, Y), B2%, PSETπIF R = 3 THEN PUT (X, Y), B3%, PSETπIF R = 4 THEN PUT (X, Y), B4%, PSETπFOR RT = 1 TO SPD * 180: NEXT RT: LINE (X, Y)-(X + 15, Y + 15), 0, BFπIF Y < 209 THENπC = (X - 100) / 15: D = (Y - 48) / 15 + 1πIF P(C, D) = 1 THEN GOTO 2πIF P(C, D) = 2 THEN GOTO 2πIF P(C, D) = 3 THEN GOTO 2πY = Y + 15: SCR = SCR + 20πELSEπ2πA = (X - 100) / 15: B = (Y - 48) / 15: P(A, B) = RπIF R = 1 THEN PUT (X, Y), B1%, PSETπIF R = 2 THEN PUT (X, Y), B2%, PSETπIF R = 3 THEN PUT (X, Y), B3%, PSETπIF R = 4 THEN PUT (X, Y), B4%, PSET: GOSUB GreenπY = 48: X = 190: IF POINT(X, Y) > 0 THEN SYSTEMπR = INT(RND * 10) + 1πIF R = 1 OR R = 2 OR R = 3 OR R = 4 THEN R = 1πIF R = 5 OR R = 6 OR R = 7 THEN R = 2πIF R = 8 OR R = 9 THEN R = 3πIF R = 10 THEN R = 4πGOSUB OkπLOCATE 5, 38: PRINT "MATCHES THIS LEVEL:"; TMTHπLOCATE 7, 38: PRINT "SCORE:"; SCR: LOCATE 6, 38: PRINT "BOTTOM MATCHES:"; BMπLOCATE 9, 38: PRINT "LEVEL:"; LVLπLOCATE 10, 38: PRINT "SPEED:"; SPD: LOCATE 11, 38: PRINT "FALL LINES:"; FLLπEND IFπIF MTH >= FLL THEN GOSUB SuperπIF BM = 3 THEN LOCATE 1, 1: PRINT "  Level Completed....": BEEP: SLEEP: GOTO 4πLOOPπOk:πCALL PlcheckπREDIM K(12, 11)πFOR M = 0 TO 12: FOR H = 0 TO 9πIF P(M, H) = 1 AND P(M, H + 1) = 1 AND P(M, H + 2) = 1 THEN LINE (M * 15 + 100, H * 15 + 48)-((M * 15 + 100) + 15, (H * 15 + 48) + 45), 0, BF: P(M, H) = 0: P(M, H + 1) = 0: P(M, H + 2) = 0: K(M, H) = 1: I = H: E = M: MTH = MTH + 1: TMTH = TMTH + 1: PRY = PRY + 15: PUT (PRX, PRY), B1%, PSETπIF P(M, H) = 2 AND P(M, H + 1) = 2 AND P(M, H + 2) = 2 THEN LINE (M * 15 + 100, H * 15 + 48)-((M * 15 + 100) + 15, (H * 15 + 48) + 45), 0, BF: P(M, H) = 0: P(M, H + 1) = 0: P(M, H + 2) = 0: K(M, H) = 1: I = H: E = M: MTH = MTH + 1: TMTH = TMTH + 1: BLE = BLE + 15: PUT (BLX, BLE), B2%, PSETπIF P(M, H) = 3 AND P(M, H + 1) = 3 AND P(M, H + 2) = 3 THEN LINE (M * 15 + 100, H * 15 + 48)-((M * 15 + 100) + 15, (H * 15 + 48) + 45), 0, BF: P(M, H) = 0: P(M, H + 1) = 0: P(M, H + 2) = 0: K(M, H) = 1: I = H: E = M: MTH = MTH + 1: TMTH = TMTH + 1: RED = RED + 15: PUT (RDX, RED), B3%, PSETπNEXT H, MπFOR M = 0 TO 10: FOR H = 0 TO 11πIF P(M, H) = 1 AND P(M + 1, H) = 1 AND P(M + 2, H) = 1 THEN LINE (M * 15 + 100, H * 15 + 48)-((M * 15 + 100) + 45, (H * 15 + 48) + 15), 0, BF: P(M, H) = 0: P(M + 1, H) = 0: P(M + 2, H) = 0: K(M, H) = 2: I = H: E = M: MTH = MTH + 1: TMTH = TMTH + 1: PRY = PRY + 15: PUT (PRX, PRY), B1%, PSETπIF P(M, H) = 2 AND P(M + 1, H) = 2 AND P(M + 2, H) = 2 THEN LINE (M * 15 + 100, H * 15 + 48)-((M * 15 + 100) + 45, (H * 15 + 48) + 15), 0, BF: P(M, H) = 0: P(M + 1, H) = 0: P(M + 2, H) = 0: K(M, H) = 2: I = H: E = M: MTH = MTH + 1: TMTH = TMTH + 1: BLE = BLE + 15: PUT (BLX, BLE), B2%, PSETπIF P(M, H) = 3 AND P(M + 1, H) = 3 AND P(M + 2, H) = 3 THEN LINE (M * 15 + 100, H * 15 + 48)-((M * 15 + 100) + 45, (H * 15 + 48) + 15), 0, BF: P(M, H) = 0: P(M + 1, H) = 0: P(M + 2, H) = 0: K(M, H) = 2: I = H: E = M: MTH = MTH + 1: TMTH = TMTH + 1: RED = RED + 15: PUT (RDX, RED), B3%, PSETπNEXT H, MπIF PRY = 340 THEN PRY = 85: PRX = PRX + 15πIF BLE = 340 THEN BLE = 85: BLX = BLX + 15πIF RED = 340 THEN RED = 85: RDX = RDX + 15πIF PRX > 20 THEN LINE (2, 85)-(31, 355), 0, BF: PRX = 2: SCR = SCR + 36100πIF BLX > 50 THEN LINE (32, 85)-(61, 355), 0, BF: BLX = 32: SCR = SCR + 362π0πIF RDX > 80 THEN LINE (62, 85)-(91, 355), 0, BF: RDX = 62: SCR = SCR + 36300πIF K(E, I) = 1 THENπSCR = SCR + 3100 + (30 * LVL) + (10 * SPD)πGET (E * 15 + 101, 48)-(E * 15 + 114, I * 15 + 48), Drop%πLINE (E * 15 + 101, 48)-(E * 15 + 114, I * 15 + 48), 0, BFπPUT (E * 15 + 101, 48 + 45), Drop%, PSETπCALL PlcheckπGOTO OkπEND IFπIF K(E, I) = 2 THENπSCR = SCR + 3100 + (30 * LVL) + (10 * SPD)πFOR J = 100 TO 130 STEP 15πGET (E * 15 + J, 48)-(E * 15 + J + 15, I * 15 + 48), Drop%πLINE (E * 15 + J, 48)-(E * 15 + J + 15, I * 15 + 48), 0, BFπPUT (E * 15 + J, 48 + 15), Drop%, PSETπNEXT JπCALL PlcheckπGOTO OkπEND IFπRETURNπSuper:πMTH = 0: CN = INT(RND * 12): P(CN, 9) = 0: P(CN, 10) = 0: P(CN, 11) = 0πSCR = 1000 + SCR + (30 * LVL) + (10 * (10 - SPD)) + (R * 200): CN = CN * 15 + 100πLINE (CN, 230)-(CN + 15, 230), 0: GET (CN, 183)-(CN + 15, 229), Spr%πFOR Y1 = 184 TO 354πLINE (CN, Y1 - 1)-(CN + 15, Y1 - 4), 0πPUT (CN, Y1), Spr%, PSETπCLL = POINT(CN + 1, Y1 + 47)πIF CLL > 0 THEN PUT (CN, Y1 + 1), Spr%, PSET: CALL Arena: GOTO 5πNEXT Y1πCALL Arenaπ'----π5πCALL PlcheckπREDIM K(12, 11)πFOR M = 0 TO 12: FOR H = 0 TO 9πIF L(M, H) = 1 AND L(M, H + 1) = 1 AND L(M, H + 2) = 1 THEN LINE (M * 15 + 100, H * 15 + 235)-((M * 15 + 100) + 15, (H * 15 + 235) + 45), 0, BF: L(M, H) = 0: L(M, H + 1) = 0: L(M, H + 2) = 0: K(M, H) = 1: I = H: E = M: MTH = MTH + 1: TMTH = TMTH + 1: PRY = PRY + 15: PUT (PRX, PRY), B1%, PSETπIF L(M, H) = 2 AND L(M, H + 1) = 2 AND L(M, H + 2) = 2 THEN LINE (M * 15 + 100, H * 15 + 235)-((M * 15 + 100) + 15, (H * 15 + 235) + 45), 0, BF: L(M, H) = 0: L(M, H + 1) = 0: L(M, H + 2) = 0: K(M, H) = 1: I = H: E = M: MTH = MTH + 1: TMTH = TMTH + 1: BLE = BLE + 15: PUT (BLX, BLE), B2%, PSETπIF L(M, H) = 3 AND L(M, H + 1) = 3 AND L(M, H + 2) = 3 THEN LINE (M * 15 + 100, H * 15 + 235)-((M * 15 + 100) + 15, (H * 15 + 235) + 45), 0, BF: L(M, H) = 0: L(M, H + 1) = 0: L(M, H + 2) = 0: K(M, H) = 1: I = H: E = M: MTH = MTH + 1: TMTH = TMTH + 1: RED = RED + 15: PUT (RDX, RED), B3%, PSETπNEXT H, MπFOR M = 0 TO 10: FOR H = 0 TO 11πIF L(M, H) = 1 AND L(M + 1, H) = 1 AND L(M + 2, H) = 1 THEN LINE (M * 15 + 100, H * 15 + 235)-((M * 15 + 100) + 45, (H * 15 + 235) + 15), 0, BF: L(M, H) = 0: L(M + 1, H) = 0: L(M + 2, H) = 0: K(M, H) = 2: I = H: E = M: MTH = MTH + 1: TMTH = TMTH + 1: PRY = PRY + 15: PUT (PRX, PRY), B1%, PSETπIF L(M, H) = 2 AND L(M + 1, H) = 2 AND L(M + 2, H) = 2 THEN LINE (M * 15 + 100, H * 15 + 235)-((M * 15 + 100) + 45, (H * 15 + 235) + 15), 0, BF: L(M, H) = 0: L(M + 1, H) = 0: L(M + 2, H) = 0: K(M, H) = 2: I = H: E = M: MTH = MTH + 1: TMTH = TMTH + 1: BLE = BLE + 15: PUT (BLX, BLE), B2%, PSETπIF L(M, H) = 3 AND L(M + 1, H) = 3 AND L(M + 2, H) = 3 THEN LINE (M * 15 + 100, H * 15 + 235)-((M * 15 + 100) + 45, (H * 15 + 235) + 15), 0, BF: L(M, H) = 0: L(M + 1, H) = 0: L(M + 2, H) = 0: K(M, H) = 2: I = H: E = M: MTH = MTH + 1: TMTH = TMTH + 1: RED = RED + 15: PUT (RDX, RED), B3%, PSETπNEXT H, MπIF PRY = 340 THEN PRY = 85: PRX = PRX + 15πIF BLE = 340 THEN BLE = 85: BLX = BLX + 15πIF RED = 340 THEN RED = 85: RDX = RDX + 15πIF PRX > 20 THEN LINE (2, 85)-(31, 355), 0, BF: PRX = 2: SCR = SCR + 36100 * 2πIF BLX > 50 THEN LINE (32, 85)-(61, 355), 0, BF: BLX = 32: SCR = SCR + 36200 * 2πIF RDX > 80 THEN LINE (62, 85)-(91, 355), 0, BF: RDX = 62: SCR = SCR + 36300 * 2πIF K(E, I) = 1 THENπBM = BM + 1πGET (E * 15 + 100, 235)-(E * 15 + 115, I * 15 + 235), Drop%πLINE (E * 15 + 100, 235)-(E * 15 + 115, I * 15 + 235), 0, BFπPUT (E * 15 + 100, 280), Drop%, PSETπCALL PlcheckπGOTO OkπEND IFπIF K(E, I) = 2 THENπBM = BM + 1πFOR J = 100 TO 130 STEP 15πGET (E * 15 + J, 235)-(E * 15 + J + 15, I * 15 + 235), Drop%πLINE (E * 15 + J, 235)-(E * 15 + J + 15, I * 15 + 235), 0, BFπPUT (E * 15 + J, 250), Drop%, PSETπNEXT JπCALL PlcheckπGOTO OkπEND IFπRETURNπGreen:πFOR II = 1 TO 1000: NEXT IIπLINE (X - 15, Y - 15)-(X + 30, Y + 30), 0, BF: CALL ArenaπCALL PlcheckπB = 0: A = 0πFOR A = 0 TO 11πFOR B = 0 TO 10πIF L(A, B) > 0 THENπ11 QQ = INT(RND * 3) + 1πIF QQ = L(A, B) THEN GOTO 11πIF QQ = 1 THEN L(A, B) = QQ: PUT (A * 15 + 100, B * 15 + 235), B1%, PSETπIF QQ = 2 THEN L(A, B) = QQ: PUT (A * 15 + 100, B * 15 + 235), B2%, PSETπIF QQ = 3 THEN L(A, B) = QQ: PUT (A * 15 + 100, B * 15 + 235), B3%, PSETπEND IFπNEXT B, AπCALL PlcheckπGOSUB SuperπRETURNπ'different NOTES, NOT SUBJECTS.ππSUB ArenaπLINE (99, 59)-(0, 59), 15πLINE (99, 83)-(0, 83), 15πCOLOR 15: LOCATE 5, 3: PRINT "*KILLED*"πLINE (281, 59)-(639, 59), 15πLINE (99, 59)-(99, 401), 15πLINE (281, 59)-(281, 401), 15πLINE (99, 230)-(281, 230), 15πLINE (99, 401)-(281, 401), 15πLINE (0, 59)-(0, 401), 15πLINE (0, 401)-(99, 401), 15πEND SUBππSUB PlcheckπFOR F = 0 TO 12: FOR G = 0 TO 11πH = POINT(F * 15 + 101, G * 15 + 49)πIF H = 13 THEN H = 1: PUT (F * 15 + 100, G * 15 + 48), B1%, PSETπIF H = 9 THEN H = 2: PUT (F * 15 + 100, G * 15 + 48), B2%, PSETπIF H = 12 THEN H = 3: PUT (F * 15 + 100, G * 15 + 48), B3%, PSETπP(F, G) = HπNEXT G, FπFOR F = 0 TO 12: FOR G = 0 TO 11πH = POINT(F * 15 + 101, G * 15 + 236)πIF H = 13 THEN H = 1: PUT (F * 15 + 100, G * 15 + 235), B1%, PSETπIF H = 9 THEN H = 2: PUT (F * 15 + 100, G * 15 + 235), B2%, PSETπIF H = 12 THEN H = 3: PUT (F * 15 + 100, G * 15 + 235), B3%, PSETπIF H = 0 THEN H = 0: LINE (F * 15 + 100, G * 15 + 235)-(F * 15 + 115, G * 15 + 250), 0, BFππL(F, G) = HπNEXT G, FπCALL ArenaπEND SUBπJohn Diamond                   IMMORTAL KOMBAT II             pages.prodigy.com/gamersp      04-06-96 (00:00)       QB, QBasic, PDS        903  19064    IMKII.BAS   'Here is Immortal Kombat II at long last.π'It has 1 different special move for each character.π'You can play agianst the computer, or a friend.π'And it has a Pit fatality.π'386/16 required for good play! do not use on a XT!π'Even though it will work it is sloooooooowwwwwwwwwwwww.π'If you operate under 50mhz you must lower the randomπ'possibilities in D1, D2, and D3 that are in the SUBπ'COMP, before you play agianst the computer.π'Enjoy!π'                               J.dπ'P.S Thanx ThOmAs and ~DAVE~ I couldn't of done thisπ'with out your help.π'Keys:π'Move:             Player 1           Player 2π'-------------------------------------------------π'foreward               6                 Dπ'backward               4                 Aπ'Jump forward           9                 Qπ'Jump Backward          7                 Eπ'Kick                   enter             Vπ'Punch                  +                 Fπ'Pit fatality           ?                 ?π'---------------------------------------------------π'Special moves have a two key combination, youπ'could be tough and figure them out your self, orπ'be a wimp and look at the INKEY commands.πDECLARE SUB ENDER ()πDECLARE SUB PITENDER ()πDECLARE SUB PIT1 ()πDECLARE SUB PIT2 ()πDECLARE SUB COMP ()πDECLARE SUB DEAD ()πDECLARE SUB STAT1 ()πDECLARE SUB STAT2 ()πDECLARE SUB SHADOW2 ()πDECLARE SUB SONIC2 ()πDECLARE SUB ICE2 ()πDECLARE SUB SPEAR2 ()πDECLARE SUB FLAME2 ()πDECLARE SUB FRY2 ()πDECLARE SUB KNIFE2 ()πDECLARE SUB KNIFE ()πDECLARE SUB ICE ()πDECLARE SUB SPEAR ()πDECLARE SUB FLAME ()πDECLARE SUB FRY ()πDECLARE SUB SHADOW ()πDECLARE SUB SONIC ()πDECLARE SUB WALKF2 ()πDECLARE SUB WALKB2 ()πDECLARE SUB PUNCH2 ()πDECLARE SUB KICK2 ()πDECLARE SUB JUMP2 ()πDECLARE SUB JUMPB2 ()πDECLARE SUB PUNCH1 ()πDECLARE SUB KICK1 ()πDECLARE SUB JUMP1 ()πDECLARE SUB JUMPB1 ()πDECLARE SUB WALKF1 ()πDECLARE SUB DRAWBACK2 ()πDECLARE SUB WALKB1 ()πDECLARE SUB getcharacters ()πDECLARE SUB DRAWBACK ()πDECLARE SUB TITLE ()πDIM SHARED FINISH1πDIM SHARED FINISH2πDIM SHARED CHAR$πDIM SHARED CHAR2$πDIM SHARED L1πDIM SHARED L2πDIM SHARED CHAR2πDIM SHARED CHARπDIM SHARED FLAGπDIM SHARED X1πDIM SHARED X2πDIM SHARED R1(800)πDIM SHARED R2(800)πDIM SHARED W1(800)πDIM SHARED W2(800)πDIM SHARED P1(800)πDIM SHARED p2(800)πDIM SHARED K1(800)πDIM SHARED K2(800)πDIM SHARED D1(800)πGP:πCOLOR 15ππLOCATE 12, 32: PRINT "How many players?"πLOCATE 13, 32: PRINT "       (1/2)";πINPUT "", PLAYERπIF PLAYER > 2 THEN GOTO GPπIF PLAYER = 0 THEN GOTO GPπL1 = 50πL2 = 50πON ERROR GOTO NOEGAπSCREEN 7: GOTO EGAπNOEGA:πFLAG = 1: SCREEN 1: GOTO EGAπEGA:πTITLEπRANDOMIZE TIMERπPRINT "1) Rayden" 'ELECTRIC THROWπPRINT "2) Sub Zero" ' ICE THROWπPRINT "3) Scorpion" ' VAN DAM SPEARπPRINT "4) Sonya" ' SONIC WAVEπPRINT "5) Johny Cage" ' SHADOW KICKπPRINT "6) Lui Kang" ' GREEN FLAMEπPRINT "7) Kano" ' KNIFE THROWπINPUT "Player 1: ", CHARπIF PLAYER = 1 THEN GOTO SKIPπINPUT "Player 2: ", CHAR2πSKIP:πIF PLAYER = 1 THEN CHAR2 = INT(RND(1) * 7) + 1πCLS : COLOR 1, 1πgetcharactersπDRAWBACKπCOLOR 4, 1πLOCATE 2, 15: PRINT "FIGHT"πX1 = 50πX2 = 260πPUT (X1, 91), R1, PSETπPUT (X2, 91), R2, PSETπIN:πK$ = INKEY$πIF FINISH1 = 1 THEN GOTO p2πIF K$ = "/" AND FINISH2 = 1 THEN PIT2πIF K$ = "6" THEN WALKF1: FLAG1 = 1: GOSUB CHECK1πIF K$ = "4" THEN WALKB1: FLAG2 = 1: GOSUB CHECK2πIF K$ = "+" THEN PUNCH1: FLAG3 = 1: GOSUB CHECK3: STAT1πIF K$ = CHR$(13) THEN KICK1: FLAG4 = 1: GOSUB CHECK4: STAT1πIF K$ = "9" THEN JUMP1πIF K$ = "7" THEN JUMPB1πIF FINISH2 = 1 THEN GOTO INπIF PLAYER = 1 THEN GOTO SP1πp2:πIF K$ = "R" AND FINISH1 = 1 THEN PIT2πIF K$ = "D" THEN WALKF2: FLAGG2 = 1: GOSUB CCHECK2πIF K$ = "A" THEN WALKB2: FLAGG1 = 1: GOSUB CCHECK1πIF K$ = "F" THEN PUNCH2: FLAGG3 = 1: GOSUB CCHECK3: STAT2πIF K$ = "V" THEN KICK2: FLAGG4 = 1: GOSUB CCHECK4: STAT2πIF K$ = "E" THEN JUMP2πIF K$ = "Q" THEN JUMPB2πIF FINISH1 = 1 AND PLAYER = 1 THEN COMP: GOTO INπIF FINISH1 = 1 THEN GOTO INπ'SPECIAL MOVES:πSP1:π'P1:πIF K$ = "1" AND FLAG2 = 1 THEN FLAG2 = 0: FRYπIF K$ = "2" AND FLAG3 = 1 THEN FLAG3 = 0: KNIFEπIF K$ = "8" AND FLAG4 = 1 THEN FLAG4 = 0: SHADOWπIF K$ = "3" AND FLAG3 = 1 THEN FLAG2 = 0: SONICπIF K$ = "1" AND FLAG3 = 1 THEN FLAG3 = 0: ICEπIF K$ = "8" AND FLAG3 = 1 THEN FLAG3 = 0: SPEARπIF K$ = "2" AND FLAG4 = 1 THEN FLAG4 = 0: FLAMEπIF PLAYER = 1 THEN COMPπIF PLAYER = 1 THEN GOTO INπ'P2πIF K$ = "Z" AND FLAGG2 = 1 THEN FLAGG2 = 0: FRY2πIF K$ = "X" AND FLAGG3 = 1 THEN FLAGG3 = 0: KNIFE2πIF K$ = "W" AND FLAGG4 = 1 THEN FLAGG4 = 0: SHADOW2πIF K$ = "C" AND FLAGG3 = 1 THEN FLAGG2 = 0: SONIC2πIF K$ = "Z" AND FLAGG3 = 1 THEN FLAGG3 = 0: ICE2πIF K$ = "W" AND FLAGG3 = 1 THEN FLAGG3 = 0: SPEAR2πIF K$ = "X" AND FLAGG4 = 1 THEN FLAGG4 = 0: FLAME2πGOTO INπCHECK1:πIF FLAG2 = 1 THEN FLAG2 = 0πIF FLAG3 = 1 THEN FLAG3 = 0πIF FLAG4 = 1 THEN FLAG4 = 0πRETURNπCHECK2:πIF FLAG1 = 1 THEN FLAG1 = 0πIF FLAG3 = 1 THEN FLAG3 = 0πIF FLAG4 = 1 THEN FLAG4 = 0πRETURNπCHECK3:πIF FLAG2 = 1 THEN FLAG2 = 0πIF FLAG1 = 1 THEN FLAG1 = 0πIF FLAG4 = 1 THEN FLAG4 = 0πRETURNπCHECK4:πIF FLAGG2 = 1 THEN FLAG2 = 0πIF FLAGG3 = 1 THEN FLAG3 = 0πIF FLAGG1 = 1 THEN FLAG1 = 0πRETURNππCCHECK1:πIF FLAGG2 = 1 THEN FLAGG2 = 0πIF FLAGG3 = 1 THEN FLAGG3 = 0πIF FLAGG4 = 1 THEN FLAGG4 = 0πRETURNπCCHECK2:πIF FLAGG1 = 1 THEN FLAGG1 = 0πIF FLAGG3 = 1 THEN FLAGG3 = 0πIF FLAGG4 = 1 THEN FLAGG4 = 0πRETURNπCCHECK3:πIF FLAGG2 = 1 THEN FLAGG2 = 0πIF FLAGG1 = 1 THEN FLAGG1 = 0πIF FLAGG4 = 1 THEN FLAGG4 = 0πRETURNπCCHECK4:πIF FLAGG2 = 1 THEN FLAGG2 = 0πIF FLAGG3 = 1 THEN FLAGG3 = 0πIF FLAGG1 = 1 THEN FLAGG1 = 0πRETURNππSUB COMPπD1 = INT(RND(1) * 20) + 1πD2 = INT(RND(1) * 25) + 1πD3 = INT(RND(1) * 65) + 1πRANDOMIZE TIMERπIF X2 > X1 + 15 AND D1 = 2 THENπX2 = X2 - 1: WALKB2πEND IFπIF X2 > X1 + 5 AND X2 < X1 + 19 AND D2 = 6 THENπPUNCH2πEND IFπIF X2 > X1 + 5 AND X2 < X1 + 19 AND D2 = 25 THENπKICK2πEND IFπIF FINISH1 = 1 THEN ENDπIF D3 = 65 THENπIF CHAR2 = 1 THEN FRY2πIF CHAR2 = 2 THEN ICE2πIF CHAR2 = 3 THEN SPEAR2πIF CHAR2 = 4 THEN SONIC2πIF CHAR2 = 5 THEN SHADOW2πIF CHAR2 = 6 THEN FLAME2πIF CHAR2 = 7 THEN KNIFE2πEND IFπIF X2 < X1 + 15 AND D1 = 20 THENπJUMP2πEND IFπEND SUBππSUB DEADπCOLOR 15πLOCATE 7, 15: PRINT "FINISH HIM"πEND SUBππSUB DRAWBACKπCLSπCOLOR 1, 1πLINE (0, 125)-(319, 155), 7, BFπLINE (30, 135)-(34, 200), 7πLINE (60, 135)-(56, 200), 7πPAINT (50, 199), 7πLINE (250, 135)-(254, 200), 7πLINE (290, 135)-(286, 200), 7πPAINT (270, 199), 7πLINE (100, 130)-(110, 130), 15πLINE (100, 130)-(100, 150), 15πLINE (100, 150)-(110, 150), 8πLINE (110, 150)-(110, 130), 8πLINE (115, 130)-(115, 150), 15πLINE (115, 130)-(125, 140), 15πLINE (125, 140)-(130, 130), 15πLINE (130, 132)-(130, 150), 8πLINE (128, 150)-(128, 140), 8πLINE (128, 140)-(125, 144), 8πLINE (125, 144)-(119, 138), 8πLINE (119, 138)-(119, 150), 8πLINE (119, 150)-(115, 150), 8πLINE (130, 150)-(128, 150), 8πLINE (135, 130)-(135, 150), 15πLINE (135, 130)-(138, 130), 15πLINE (138, 130)-(138, 140), 15πLINE (138, 140)-(143, 135), 15πLINE (143, 135)-(145, 137), 8πLINE (145, 137)-(138, 143), 8πLINE (138, 143)-(145, 150), 8πLINE (135, 150)-(145, 150), 8πIF CHAR = 1 THEN CHAR$ = "Rayden"πIF CHAR = 2 THEN CHAR$ = "Sub Zero"πIF CHAR = 3 THEN CHAR$ = "Scorpion"πIF CHAR = 4 THEN CHAR$ = "Sonya"πIF CHAR = 5 THEN CHAR$ = "Johny Cage"πIF CHAR = 6 THEN CHAR$ = "Lui Kang"πIF CHAR = 7 THEN CHAR$ = "Kano"ππIF CHAR2 = 1 THEN CHAR2$ = "Rayden"πIF CHAR2 = 2 THEN CHAR2$ = "Sub Zero"πIF CHAR2 = 3 THEN CHAR2$ = "Scorpion"πIF CHAR2 = 4 THEN CHAR2$ = "Sonya"πIF CHAR2 = 5 THEN CHAR2$ = "Johny Cage"πIF CHAR2 = 6 THEN CHAR2$ = "Lui Kang"πIF CHAR2 = 7 THEN CHAR2$ = "Kano"πLOCATE 1, 1: PRINT CHAR$; CHAR2$πEND SUBππSUB DRAWBACK2πIF FLAG = 0 THENπLINE (0, 26)-(319, 124), 1, BFπEND IFπIF FLAG = 1 THENπLINE (0, 26)-(319, 124), 0, BFπEND IFπCOLOR 15πLOCATE 5, 4: PRINT CHAR$πLOCATE 5, 25: PRINT CHAR2$πCOLOR 1, 1πSTAT1πSTAT2πEND SUBππSUB ENDERπCOLOR 15πLOCATE 7, 14πIF FINISH1 = 1 THEN PRINT CHAR2$;πIF FINISH2 = 1 THEN PRINT CHAR$;πPRINT " Wins!"πWHILE INKEY$ = "": WENDπWHILE INKEY$ = "": WENDπSYSTEMπEND SUBππSUB FLAMEπIF CHAR <> 6 THEN EXIT SUBπDRAWBACK2πPUT (X1, 91), P1πPUT (X2, 91), R2πFOR I = X1 + 12 TO X2πCIRCLE (I, 91 + 15), 3, 10πPUT (X1, 91), P1πPUT (X2, 91), R2πDRAWBACK2πNEXTπPUT (X1, 91), R1πPUT (X2, 91), R2πL2 = L2 - 5: STAT2πEND SUBππSUB FLAME2πIF CHAR2 <> 6 THEN EXIT SUBπDRAWBACK2πPUT (X2, 91), p2πPUT (X1, 91), R1πI = X2πFOR V = X1 + 12 TO X2πI = I - 1πCIRCLE (I, 91 + 15), 3, 10πPUT (X2, 91), p2πPUT (X1, 91), R1πDRAWBACK2πNEXTπPUT (X1, 91), R1πPUT (X2, 91), R2πL1 = L1 - 5: STAT1πEND SUBππSUB FRYπIF CHAR <> 1 THEN EXIT SUBπDRAWBACK2πPUT (X1, 91), P1πPUT (X2, 91), R2πIF FLAG = 0 THENπLINE (X1 + 16, 91 + 19)-(X2 + 8, 91 + 19), 14πEND IFπIF FLAG = 1 THENπLINE (X1 + 16, 91 + 19)-(X2 + 8, 91 + 19), 1πEND IFπFOR I = 1 TO 500: NEXTπDRAWBACK2πPUT (X1, 91), R1πPUT (X2, 91), R2πL2 = L2 - 7: STAT2πEND SUBππSUB FRY2πIF CHAR2 <> 1 THEN EXIT SUBπDRAWBACK2πPUT (X1, 91), R1πPUT (X2, 91), p2πIF FLAG = 0 THENπLINE (X2, 91 + 19)-(X1 + 8, 91 + 19), 14πEND IFπIF FLAG = 1 THENπLINE (X2, 91 + 19)-(X1 + 8, 91 + 19), 1πEND IFπFOR I = 1 TO 500: NEXTπDRAWBACK2πPUT (X1, 91), R1πPUT (X2, 91), R2πL1 = L1 - 7: STAT1πEND SUBππSUB getcharactersπ'R1πCIRCLE (7, 7), 5, 7πLINE (7, 12)-(7, 24), 8πLINE (7, 24)-(0, 33), 5πLINE (7, 24)-(14, 33), 5πLINE (7, 19)-(12, 12), 8πGET (0, 0)-(15, 33), R1π'R2πCIRCLE (28, 7), 5, 7πLINE (28, 12)-(28, 24), 8πLINE (28, 24)-(21, 33), 5πLINE (28, 24)-(35, 33), 5πLINE (28, 19)-(19, 12), 8πGET (18, 0)-(35, 33), R2π'W1πCIRCLE (49, 7), 5, 7πLINE (49, 12)-(49, 33), 8πLINE (49, 24)-(49, 33), 5πLINE (49, 24)-(56, 33), 5πLINE (49, 19)-(54, 12), 8πGET (39, 0)-(56, 33), W1π'W2πCIRCLE (70, 7), 5, 7πLINE (70, 12)-(70, 33), 8πLINE (70, 24)-(70, 33), 5πLINE (70, 24)-(65, 33), 5πLINE (70, 19)-(65, 12), 8πGET (60, 0)-(75, 33), W2π'P1πCIRCLE (91, 7), 5, 7πLINE (91, 12)-(91, 24), 8πLINE (91, 24)-(86, 33), 5πLINE (91, 24)-(96, 33), 5πLINE (91, 19)-(100, 19), 8πGET (81, 0)-(101, 33), P1π'P2πCIRCLE (112, 7), 5, 7πLINE (112, 12)-(112, 24), 8πLINE (112, 24)-(107, 33), 5πLINE (112, 24)-(117, 33), 5πLINE (112, 19)-(101, 19), 8πGET (101, 0)-(117, 33), p2π'K1πCIRCLE (133, 7), 5, 7πLINE (133, 12)-(133, 33), 8πLINE (133, 24)-(133, 33), 5πLINE (133, 24)-(148, 24), 5πLINE (133, 19)-(138, 12), 8πGET (123, 0)-(148, 33), K1π'K2πCIRCLE (164, 7), 5, 7πLINE (164, 12)-(164, 33), 8πLINE (164, 24)-(164, 33), 5πLINE (164, 24)-(150, 24), 5πLINE (164, 19)-(159, 12), 8πGET (149, 0)-(170, 33), K2π'DπLINE (174, 15)-(195, 15), 4πLINE (174, 17)-(195, 17), 4πLINE (195, 16)-(216, 16), 9πCIRCLE (222, 16), 5, 6πGET (174, 12)-(227, 22), D1πEND SUBππSUB ICEπIF CHAR <> 2 THEN EXIT SUBπIF FLAG = 1 THEN C = 1πIF FLAG = 0 THEN C = 9πPUT (X1, 91), P1πPUT (X2, 91), R2πFOR I = X1 + 12 TO X2πLINE (I, 106)-(I + 5, 110), C, BFπPUT (X1, 91), R1πPUT (X2, 91), R2πDRAWBACK2πNEXTπPUT (X1, 91), R1πPUT (X2, 91), R2πL2 = L2 - 3: STAT2πEND SUBππSUB ICE2πIF CHAR2 <> 2 THEN EXIT SUBπIF FLAG = 1 THEN C = 1πIF FLAG = 0 THEN C = 9πPUT (X2, 91), p2πPUT (X1, 91), R1πI = X2πFOR V = X1 + 12 TO X2πI = I - 1πLINE (I, 106)-(I + 5, 110), C, BFπPUT (X1, 91), R1πPUT (X2, 91), R2πDRAWBACK2πNEXTπPUT (X1, 91), R1πPUT (X2, 91), R2πL1 = L1 - 3: STAT1πEND SUBππSUB JUMP1π        IF X1 > 285 THEN EXIT SUBπ        DRAWBACK2π        PUT (X2, 91), R2π        PUT (X1, 85), R1π        DRAWBACK2π        FOR I = 1 TO 5π        X1 = X1 + 1π        PUT (X1 + I + 10, 76 + I), R1π        PUT (X2, 91), R2π        DRAWBACK2π        NEXTπ        X1 = X1 + 30π        PUT (X1, 91), R1π        PUT (X2, 91), R2ππEND SUBππSUB JUMP2πIF X2 > 262 THEN EXIT SUBπDRAWBACK2πPUT (X2, 91), R2πPUT (X1, 85), R1πDRAWBACK2πFOR I = 1 TO 5πX2 = X2 + 1πPUT (X2 + I + 10, 76 + I), R2πPUT (X1, 91), R1πDRAWBACK2πNEXTπX2 = X2 + 30πPUT (X1, 91), R1πPUT (X2, 91), R2πππEND SUBππSUB JUMPB1πIF X1 < 35 THEN EXIT SUBπDRAWBACK2πPUT (X2, 91), R2πPUT (X1, 85), R1πDRAWBACK2πFOR I = 1 TO 5πX1 = X1 - 1πPUT (X1 - I - 10, 76 + I), R1πPUT (X2, 91), R2πDRAWBACK2πNEXTπX1 = X1 - 30πPUT (X1, 91), R1πPUT (X2, 91), R2ππEND SUBππSUB JUMPB2πIF X2 < 35 THEN EXIT SUBπDRAWBACK2πPUT (X2, 91), R2πPUT (X1, 85), R1πDRAWBACK2πFOR I = 1 TO 5πX2 = X2 - 1πPUT (X2 - I - 10, 76 + I), R2πPUT (X1, 91), R1πDRAWBACK2πNEXTπX2 = X2 - 30πPUT (X1, 91), R1πPUT (X2, 91), R2πππEND SUBππSUB KICK1πDRAWBACK2πPUT (X2, 91), R2πPUT (X1, 91), K1πFOR I = 1 TO 1000: NEXTπDRAWBACK2πPUT (X2, 91), R2πPUT (X1, 91), R1πIF X1 + 16 > X2 AND X1 < X2 + 12 THEN L2 = L2 - 1: STAT2πEND SUBππSUB KICK2πDRAWBACK2πPUT (X1, 91), R1πPUT (X2, 91), K2πFOR I = 1 TO 1000: NEXTπDRAWBACK2πPUT (X1, 91), R1πPUT (X2, 91), R2πIF X2 - 8 < X1 + 10 THEN L1 = L1 - 1: STAT1πEND SUBππSUB KNIFEπIF CHAR <> 7 THEN EXIT SUBπDRAWBACK2πPUT (X1, 91), P1πPUT (X2, 91), R2πFOR I = X1 + 12 TO X2πLINE (I, 95)-(I + 5, 100), 7πPUT (X1, 91), R1πPUT (X2, 91), R2πDRAWBACK2πNEXTπPUT (X1, 91), R1πPUT (X2, 91), R2πL2 = L2 - 5: STAT2πEND SUBππSUB KNIFE2πIF CHAR <> 7 THEN EXIT SUBπDRAWBACK2πPUT (X1, 91), p2πPUT (X2, 91), R1πI = X2πFOR V = X1 + 12 TO X2πI = I - 1πLINE (I, 95)-(I + 5, 100), 7πPUT (X1, 91), R1πPUT (X2, 91), R2πDRAWBACK2πNEXTπPUT (X1, 91), R1πPUT (X2, 91), R2πL1 = L1 - 5: STAT1πEND SUBππSUB PIT2πCLSπFOR Y = 1 TO 180πCOLOR 1, 1πLINE (34, 0)-(56, 200), 7, BFπLINE (254, 0)-(286, 200), 7, BFπLINE (0, 190)-(319, 200), 7, BFπFOR I = 1 TO 320 STEP 20πLINE (I, 190)-(I + 5, 180), 15πLINE (I + 15, 190)-(I + 10, 180), 15πNEXTπLINE (34, 0)-(34, 200), 7πLINE (56, 0)-(56, 200), 7πPAINT (36, 1), 7πIF FINISH2 = 1 THEN PUT (X2, Y), D1, PSETπIF FINISH1 = 1 THEN PUT (X1, Y), D1, PSETπFOR I = 1 TO 150: NEXTπLINE (57, 0)-(253, 176), 1, BFπNEXTπLINE (254, 0)-(286, 200), 7, BFπLINE (0, 190)-(319, 200), 7, BFπFOR I = 1 TO 320 STEP 20πLINE (I, 190)-(I + 5, 180), 15πLINE (I + 15, 190)-(I + 10, 180), 15πNEXTπLINE (34, 0)-(34, 200), 7πLINE (56, 0)-(56, 200), 7πPAINT (36, 1), 7πPITENDERπππEND SUBππSUB PITENDERπCOLOR 15πLOCATE 4, 15: PRINT "PIT FATALITY"πLOCATE 7, 13πIF FINISH1 = 1 THEN PRINT CHAR2$;πIF FINISH2 = 1 THEN PRINT CHAR$;πPRINT " Wins!"πWHILE INKEY$ = "": WENDπWHILE INKEY$ = "": WENDπSYSTEMπEND SUBππSUB PUNCH1πDRAWBACK2πPUT (X2, 91), R2πPUT (X1, 91), P1πFOR I = 1 TO 1000πNEXTπDRAWBACK2πPUT (X1, 91), R1πPUT (X2, 91), R2πIF X1 + 16 > X2 AND X1 < X2 + 12 THEN L2 = L2 - 1: STAT2πEND SUBππSUB PUNCH2πDRAWBACK2πPUT (X1, 91), R1πPUT (X2, 91), p2πFOR I = 1 TO 1000: NEXTπDRAWBACK2πPUT (X1, 91), R1πPUT (X2, 91), R2πIF X2 - 8 < X1 + 8 THEN L1 = L1 - 1: STAT1πEND SUBππSUB SHADOWπIF CHAR <> 5 THEN EXIT SUBπDRAWBACK2πPUT (X2, 91), R1πFOR I = 1 TO 10πX1 = X1 + 5πPUT (X1, 91), K1πPUT (X2, 91), R2πDRAWBACK2πNEXTπDRAWBACK2πPUT (X1, 91), R1πPUT (X2, 91), R2πIF X1 > X2 THEN L2 = L2 - 6: STAT2πEND SUBππSUB SHADOW2πIF CHAR2 <> 5 THEN EXIT SUBπDRAWBACK2πPUT (X1, 91), R1πFOR I = 1 TO 10πX2 = X2 - 5πPUT (X2, 91), K2πPUT (X1, 91), R1πDRAWBACK2πNEXTπDRAWBACK2πPUT (X1, 91), R1πPUT (X2, 91), R2πIF X2 < X1 + 12 THEN L1 = L1 - 6: STAT1ππEND SUBππSUB SONICπIF CHAR <> 4 THEN EXIT SUBπIF FLAG = 1 THEN C = 2πIF FLAG = 0 THEN C = 12πDRAWBACK2πPUT (X1, 91), P1πPUT (X2, 91), R2πFOR I = X1 TO X2πLINE (I, 98)-(I, 105), CπLINE (I + 2, 97)-(I + 1, 104), CπLINE (I + 4, 96)-(I + 2, 103), CπPUT (X1, 91), R1πPUT (X2, 91), R2πDRAWBACK2πPUT (X1, 91), R1πPUT (X2, 91), R2πNEXTπL2 = L2 - 4: STAT2πEND SUBππSUB SONIC2πIF CHAR <> 4 THEN EXIT SUBπIF FLAG = 1 THEN C = 2πIF FLAG = 0 THEN C = 12πDRAWBACK2πPUT (X2, 91), p2πPUT (X1, 91), R1πI = X2πFOR V = X1 TO X2πI = I - 1πLINE (I, 98)-(I, 105), CπLINE (I - 2, 97)-(I - 1, 104), CπLINE (I - 4, 96)-(I - 2, 103), CπPUT (X1, 91), R1πPUT (X2, 91), R2πDRAWBACK2πPUT (X1, 91), R1πPUT (X2, 91), R2πNEXTπL1 = L1 - 4: STAT1πEND SUBππSUB SPEARπIF CHAR <> 3 THEN EXIT SUBπDRAWBACK2πPUT (X1, 91), P1πPUT (X2, 91), R2πLINE (X1 + 16, 91 + 19)-(X2 + 8, 91 + 19), 8πFOR I = X1 TO X2 - 15πX2 = X2 - 1πPUT (X1, 91), P1πPUT (X2, 91), R2πLINE (X1 + 16, 91 + 19)-(X2 + 8, 91 + 19), 8πDRAWBACK2πNEXTπPUT (X1, 91), R1πPUT (X2, 91), R2πL2 = L2 - 4: STAT2πEND SUBππSUB SPEAR2πIF CHAR2 <> 3 THEN EXIT SUBπDRAWBACK2πPUT (X2, 91), p2πPUT (X1, 91), R1πLINE (X2, 91 + 19)-(X1 + 8, 91 + 19), 8πFOR I = X1 TO X2 - 15πX1 = X1 + 1πPUT (X2, 91), p2πPUT (X1, 91), R1πLINE (X2, 91 + 19)-(X1 + 8, 91 + 19), 8πDRAWBACK2πNEXTπPUT (X1, 91), R1πPUT (X2, 91), R2πL1 = L1 - 4: STAT1πEND SUBππSUB STAT1πIF FINISH1 = 1 OR FINISH2 = 1 THEN ENDERπIF L1 < 0 THEN DEAD: FINISH1 = 1πIF FLAG = 0 THEN C1 = 14: C2 = 4πIF FLAG = 1 THEN C1 = 4: C2 = 2πLINE (0, 5)-(150, 25), C1, BFπLINE (L1 * 3, 5)-(150, 25), C2, BFπEND SUBππSUB STAT2πIF FINISH1 = 1 OR FINISH2 = 1 THEN ENDERπIF L2 < 0 THEN DEAD: FINISH2 = 1πIF FLAG = 0 THEN C1 = 14: C2 = 4πIF FLAG = 1 THEN C1 = 4: C2 = 2πLINE (170, 5)-(320, 25), C1, BFπLINE (L2 * 3 + 170, 5)-(320, 25), C2, BFπEND SUBππSUB TITLEπCOLOR 0, 7πLINE (50, 20)-(50, 150), 15πLINE (50, 20)-(75, 20), 15πLINE (75, 20)-(75, 150), 8πLINE (75, 150)-(50, 150), 8πLINE (90, 20)-(90, 150), 15πLINE (90, 20)-(115, 70), 15πLINE (115, 70)-(130, 20), 15πLINE (130, 22)-(130, 150), 8πLINE (125, 150)-(125, 65), 8πLINE (125, 65)-(115, 85), 8πLINE (115, 85)-(105, 65), 8πLINE (105, 65)-(105, 150), 8πLINE (105, 150)-(90, 150), 8πLINE (125, 150)-(130, 150), 8πLINE (140, 20)-(140, 150), 15πLINE (140, 20)-(150, 20), 15πLINE (150, 20)-(150, 90), 15πLINE (150, 90)-(175, 70), 15πLINE (175, 70)-(180, 80), 8πLINE (180, 80)-(150, 100), 8πLINE (150, 100)-(190, 150), 8πLINE (190, 150)-(140, 150), 8πCOLOR 1πLOCATE 1, 1: PRINT "IMMORTAL KOMBAT.........."πLOCATE 20, 15: PRINT "1994 G.P.S Software......"πLOCATE 22, 10: PRINT "By: John Diamond"πWHILE INKEY$ = "": WENDπCLS : COLOR 15, 0π'IF FLAG = 1 THEN SCREEN 1π'IF FLAG = 0 THEN SCREEN 7πEND SUBππSUB WALKB1πIF X1 < 5 THEN EXIT SUBπDRAWBACK2πPUT (X2, 91), R2πX1 = X1 - 4πPUT (X1, 91), W1πX1 = X1 - 1πFOR I = 1 TO 200: NEXTπDRAWBACK2πX1 = X1 - 1πPUT (X1, 91), R1πPUT (X2, 91), R2πEND SUBππSUB WALKB2πIF X2 < 2 THEN EXIT SUBπDRAWBACK2πPUT (X1, 91), R1πX2 = X2 - 4πPUT (X2, 91), W2πFOR I = 1 TO 200: NEXTπDRAWBACK2πX2 = X2 - 1πPUT (X1, 91), R1πPUT (X2, 91), R2πEND SUBππSUB WALKF1πIF X1 > 295 THEN EXIT SUBπDRAWBACK2πPUT (X2, 91), R2πX1 = X1 + 4πPUT (X1, 91), W1πFOR I = 1 TO 200: NEXTπDRAWBACK2πPUT (X2, 91), R2πX1 = X1 + 1πPUT (X1, 91), R1πEND SUBππSUB WALKF2πIF X2 > 295 THEN EXIT SUBπDRAWBACK2πPUT (X1, 91), R1πX2 = X2 + 4πPUT (X2, 91), W2πFOR I = 1 TO 200: NEXTπDRAWBACK2πX2 = X2 + 1πPUT (X2, 91), R2πPUT (X1, 91), R1πEND SUBππEric Carr                      (SONIC) SPINBALL               FidoNet QUIK_BAS Echo          04-08-96 (16:48)       QB, QBasic, PDS        139  9220     SONIC.BAS   'Hey! Here is a little sonic like game that i made about 1 1/2 to 2 years ago,π'and just thought I'd post it.It's call Spinball..It's in screen mode 7, iπ'think, so it uses page flipping.  To move the little guy use the left [Ctrl] &π'[Alt] keys for left & right, and the right [Shift] key for jumping. I alsoπ'made a little save feature( [s] to save, [l] to restore) but caps lock has toπ'be off for it to work..Also, if it's too fast or slow, adjust the DELA, or useπ'the white -/+ keys to change. It runs fine on my 486sx when compiled. Again,π'remember I made this a couple years ago, so.....ππDEFINT A-Z:DIM SHARED K,S,B&,Z&:V1 'Created by PostIt! 7.2πSUB V1:OPEN "O",1,"SB.ZIP",4^6:Z&=6196:?STRING$(50,177);πU"%up()%9%'%.-%#./REab,sDC%.%%6%%%%-%%%%xf&%jSi%fyxU%ye+k+KAa8103πU"mVAYoyL&5Map1p3\+4/5+%%up()%9%'%%-%%9#HB=>;$5u&%%%v6%%%+%%%%xg%πU"SvuhEF&fA]<U-5hFuNAC8SISlnwf.\Xb+Oe'siM9Bj\:n]e))rGTqkuv.%nc3]#πU"'#PS\km&<90^l(\$]p2Sch4Eg'M:&k&uU9W9*'vO9444Vi:PmODo0:+0m[4><NgπU"pXBp'&V#cR6P6P)TZLZKEcu6:?F,HX,nZ^W2+UaEV'Qg)/KR424lUC+Q=7k\:sCπU"'=e5(rrsHQeII/?6uAO#S_m9=qGaZ&_4r%(8f1)?I$Wl?4H\U^?-SdJDQ%IDs+7πU"IN8oznlNep5vZs]MouZ[/'e?843sCB7ore,,(sat;XIZU9?_SGT3tO:i5X&F\0jπU"i<0=1CQ*=dz8[Hs3Qqw$)(+LAyD1rWfwAuSZk6L)>>C\/)&<HN4ucP3FW26j8YsπU":N>Fl8;^PA>ZWNPWSme<kUhk3z_0>7>^C9ejL6<]I)jW?DGe<.rfulh.0;y.F-,πU"#Go^Ndmi8m6)8p*98R'H<MxZ\kI/7^p9)BQG5z+e%D[-0g;e3eQpEP=3Kz&_7PIπU"EZwEcN4[=[\UwoIXALWSi_WB[/:UHPXyaaZ4O['4R17G8C?aEYCvO8D]pHm-1I?πU"34D=;sZW8Y;ct;-Z0L[K+ja['2*98]m0:sbsuY#Sg6fADYLnnOG-ZPl)FlqpHiYπU"y(Fa<.C>d%up()%9%'%.-%*.8RER(=tl*'.%%JJ%%%1%%%%xu%nsgf%qqSiRfYfπU"g<8]UEX5?tb0oButIXvy</$G4RVcZ-xfk1CmbHXa:9.V?+I1([\lx&ahV=>6Z>^πU"X#1:C27btsurwU(M6NKx/n>t>ptvuoo^oKODY-Y_LM3'XY9yG;%o_$3Y$S<[tUJπU"s+(_Gfc\+?OB_2')?6t]]WBT,UgKi2VVwJ7e$RJ3bH,T\-Mufsues,1ig?9=9=eπU"OYu3prHKIuD6;I43hiXW3Kb_uLT$4ZBq1==Hzk/QW]t[;54mgrRZDit(U&s$o%YπU"NYiYeQAF9o'MWVjL;,K2x--nCM*:F$J7C6euXggpiP3eM]%X,CcHqFlKdQg^'VLπU"1rlH(2p8zV*[Y=5b<-k4X.cMFgUf<&hq*L+mpYY8uGWVN1\'/yxH4($)/c$C'3CπU",F>)FuEZi#=/)B'3B,X8>E%oU2i*[0CA$kn,?LJxpk8b/:j*jo(P<M5?y9$I?8oπU"GtilgZBfY?+35$(4cHH3gSakl*Z#h:FSvr/_-TM1S?p;0^6u(lsj16G1xGu)dcLπU"\i<jerI4ZtVeIFA'0kvZr-K/TN_GfOO[9\;iceuKwg8oux''1c6343Wl.S>#2c9πU"_JVf2-LB-Kh3m?:GS<oi1zB(d(4%)B7AQTL,:wP:\Cc3TqpS5-1\zkK60KmRuN<πU"vL(tUm)+E:U'YB*<(6j&D7dqXnRWP%$;*M1UqLs,bpQGiu0.d+u0i:)0A>u0+Z-πU":Fe86#5f4F5*(j\w$)971'%P)YhJ<0Qmv_S'x(;Q*xR*iKX0Istg#_&m0#/CLd&πU"PVk-vs'%<Js[\/iYL;g>D<ILG*#PtvA',,7+?r/]LV&^Rd8t$(7,t/Y$\xYnUOyπU"i+DP-%fJKjvBoZ$bXSTlqr6ZBk]X77Dm<qNq0-;x'u%p()9%%'%-C%5.RXE**U,πU"<U%%(%o/%%%1%%%%xun%sgfq%qSVU4Zfdr+3;E5bTpIUU&>i[FP/Z=j-*JHH8[;πU"1KrNc82\rwV$7sRl5olD_Kv^]rUzfjKfSnp.be[E>)-YFmRr/\>7WRZ2#a4^,$fπU"#RTIW>]\ds[Kc.t?l9O^7Mwn&0>\3L$RD-[9hwB;:3w>J5Z])Ah,^hSY7Ger=sDπU"CL%+j$]?V9_)J1>V00aI-)JDKCKm1cTAaPA<Qg2pCi42VS^nFtQsM?mW9;7K6V8πU">YOl6V2M[hvyMOCAKU$i)Z3\Iz^IS.?T5u?1>Sr-VLORwBL6n$?^&&up(%)9%'%πU"%-%q(.RE3KRMQZ%&%%*%2%%1%%%%x%unsg%fqqS[ifFVJfr=SdU1Tp=mU:lFmN:πU"*BMv:xhi$_3fb>Aj;moT7$)X(H1Fs9<LZZ3c'YTTdsTEtv9^[6sP^2s^-#vkt&LπU"\1hoXbpV/+BNb4q?*V#?=i=GJ_]t,[dp]#qk+$c?9jA>ODhK4+ct=PoU4;>4%3gπU"/oj-QdnoRZ[SW-^RSX[g.SU1Wk_4(#J=st%V5[PC[A=y:Im_K[RxBWz8MI%+s+SπU"AES?Cnzb/i-F<\abeo#OI3T6wgtO4I#'UBht\.6Jc>\a$Vm(eBBZP[MrecZU^\#πU"p=$tCJU1xqe0T4Zq(Q?r+2N+pW_hx:&RG><t/8:TtrnTDpl_lt799_oEr5O>IB0πU"_//uXFRT]$GXP%0fZ:IP6(ex31q=[TRtH$.R&(_=6dX+/(#KHg'i#M1YS+JpxM1πU"gf7-GYZl#3,>n?r2FF0P>S='Y3)vQHQ=VL'2;/fA<O^WfCu-091DqbMGU64J0Z5πU"?/BPSO/hwyR%1^0lCZ98GxxVrcvxlX&L(up%()9%%'%-%.u.RE81^1l'*&%%&A?πU"%%%1%%%%xuns%gfqq%SifWWfh:=&SE5eohKw<eK'<pi[dCLWQgV3_bun89:Dh<EπU"m)<&1f/U&s6,fG#CYkH[4i=Qt^Ldj*kE^4Flq_nP]i+&srLMNPp'm-9cogB#4*hπU"p(BqU>KY#;T.a6p%8ug/[#u;%1fj(m;<firECBs'E?,p3w1u\/>JWITpi%FXX9FπU"v)1U-f9*-oXsNEqnp8#*i&e?hXrM.6*0B&&NemhpT1:+Yo*SpP_le-+0fQghFXfπU")*#/N<\C%'eQp&IK6Y+bA\:]\7nsd4/TdqE&Oxq&nTz&INXqkQ2bq4v.-[4KL*.πU"]7.NMX.'$ro\l#vc<(JFNIJ&l#'&Q4H2X=1HeNNL7kT[&]wtl$tmJ3V&)jM)tDCπU"-##bgMYR,f,Qp,6Rf#gOq5,9-0aQ8-GX._=:MQJHbRf)e2PTdf_MQd&l8c3heZ^πU"ks]vV^$#hZS$'E5C-khBLAlB76I[leIW6B+Iu&$[m1kST8qXc29bwS>tUFkHK.fπU"8kVT,qfo?a4T,tFfx4<\3mC(*G8dFL6U#p?AX1n#Ofmh0m,4ZnjX?lTx$j%0up(πU"%)9%'%%-%z^.REqGNuMf#&%%+%Q%%1%%%%x%unsg%fqqS[ifXfMh,=RdU1OXP$1πU"R^:5xT(l(WyBFwNodco+Xqu[4>C&OS&7IZ&k]'QgJg7ucxItEE$rrvGv1h-=6qNπU"3k^?Mwzu8?cciwk&(u'+U01-'Y6&)rQ'CK3kjw%7Rf.yXRx2eXivTFVs4JhO)NfπU"y<^b'c$OdvAequ$b[h%jaIaF]?F#,H(C5A$1DQO*(,0iash1Pt&GOrBP-r<VH7'πU"7.J,8Ok)0nzA]5&k3Um?(xVuk4)RPF):-\EXJJ96u#eB+;g/H$EEV2?&&6'kGafπU"^Q3l)D5nGc>Wi_Gu%+j[sJvkv[E)AZT&hoTF5.j^%j=t63X>i:/Up1MghTwOA'FπU"aF2XO9*FjQ30Tk-F>)*x<90A>Y5Xe9MD&0b)uDSHdw^HCk17-#m%7x5/5DKKk;fπU"I-\0=g=PfYmX.^H(wJ:*ttFl.-F/-o:%Q#Kc-,CQqPT(.)H[e(.%U.>]ip#Ja5uπU"%[U05iDP'UMg)2*:IQe_g=6:?t6pZM]neE-x_E9*\eItvn.i6a5&M%up%()9%%'πU"%-%.R.RE>Y=VM&s/%%'=N%%%+%%%%xgSg7fxf?q,>TANj,Om9t_J>(Udm&8FJR7πU"BHVe$%Pj/J]+GBD/INkiooBY,YQQPVPoA>9ottsUe.5ohlpShvLEfa4e*sY/*9(πU"K^WUl(lhlllVA4M+rJ8+MBOv&SrI.QuJU3BVI%(F'?>oWK>8B1=249^4vn-[GD*πU"?uQn%ZU2BD]O,nFd;P/ZNC$^/&3z81q4&3jL1zYj;:=.(7\+-3-ydE4o:RYAg.VπU"TK<+o972g9K.eOU/.$9$ts5%xfkvD*1?vb$#E1,&0tl:>cg8+kX]USd:-tNTDSNπU"jYuD)X83e.pbJc-hlJQDIN%ARfaR'JY^f:hti(mO3t))Wv'=Oqus)CvDdoUc'36πU"E86vx2E-I$Dz%s.\^G&L%](64oI;NCj'N.9I0W^Tu3$B')(_v;+MZyq#hWnkC/xπU"5yhSN)p-wDdKi:,)\t.:l.P66k%7PRp%)51ge3Dy(Q15>O4g]U-(O,R:c:V[,=)πU")=#i\S/9AVBj$h)V,TWG?_-2MZG,#HL=Rau=aOOg'-$,.VRP-/$.z\gBEOH4(^TπU"C[iHY5W\1X2.z,nBfkRKo7,^h(6VQQRi8^<mY3/&JH.^t4lT7&TXL,f;,0TvH3pπU"x;4lgLEEMzd#OnWmP#:liFkXh#&zj&6.&9eT_YK9b'kDxw5Xo0/173mydIbej&JπU"[XzoQ.s<mhYzg:h>HZ=uT>%kJ^FR%cGJIgXUGP'y=3MAo7wlIuL/ydxDg6E7R)rπU"\?(iiu=]jXD3b\<+duY&PdC:+>#]^SGF&SDgM.llW:QrYgXgYZ6;L(TO[%hJRQ;πU"sd1V]Pwska0Y=-f#+yN9+u[xtpZa_j:5+::_T%EA]u?:;J_EM3QvXD/WbVxpI][πU"9TH))%eRIzsJ)5^u;x&t6m-Um6-tA$[&HY?-Cn]%i(W%_G#P>fCbza:ngLfrqpsπU"FRqJ>8U+tcp-:;nU]v^lWTZ]HDv5L[nkNZiOMe_,rf5E/p^Qq%h_>I?29z]9s&cπU"U&$q$fAu20pF6-HFDdO-k)^=GBd=*$gqQ^Y=u;Qgq6UH$\O+EBawE_hc']F6ipgπU"kWZ'gB(YfcIOZS:^rAxbrfV<anyd:^d[EFGJQ<2*C_K-i_ai\uT$huWr<Gf%hkTπU"7AZZ02,L^W?8[rO&YV5/cWuoi+H-KFg3bK;j[;b4lGLY,VqFrgGBS+[^j?RhCX&πU"dNP[:$[,B9waGB?kkhFB#<rJfl;ZGmR]=uGg%ci1J$[wiUVMWqn=J[-ilUT\qi>πU"=<w/VK%baTvxjH2RrX_Lj4X?C$iFIcTX^<NkL7bH$Fkgd;:G$N=Bkr0<FR5$H.pπU"PLl*X\gbiuZT/?K4RlHuMZN<:6F'[EEhl2lu7eOHn*zs+Jro.BAdA:hCM/pWoPRπU"/gh];,&qn1SCYh/8TWb./jh>+5>UD1nKtjv?4O^aBtbaGP+o2+u)\)>tm3cZ<kfπU"eIDalJ&j98\*l_]Fd98Rb-r288y5Dr#>k=%L?<Ne$Ovm;#kPp4m/gYI$_ebqSK^πU"^D&,#dJ:r7um^pc\)P;N2Q#*Iqa5C<SoV',VWNx%;#/PK6brDSoTJX=2]BQ76[sπU"ptsC5])9(f5Cr<XW,bDdW$X^5>A_K/4dr<[28muInMccmB7S9v-]*9QN9(*>11+πU"bFet&K'vhmT+Boo0m76<OXM$I[ldF^dBJY31^m830qwv\.Ltgm_.R>RSgv&-e&2πU"BspK-m^aEKe#:%Htr(D:TRHSHa2L8tieX\/^\Fv,rQ$/vB)SxX6#5m_pRi*5k4KπU"R=]_#XRH_$-=$(hptSQ9kzDzRrS58QZfmxHes5TGT6VkO/n\FKa+y5\CorJC(*uπU"5gaw%KU\2()9bxCm'tO.cJ\pFdF(AWl')oYJ%zTNf5a3A5chS+>O2&yFRe+q%;SπU"P2.7(OhzcBjc&8g.duI40(J]A/rR:?>&NoXnL.owN0VHKo-Gr4w^fOgTutof6QCπU",q'ySIhn\>,E$81kh46'hi[v'7:tVw4aNy6_e-pCWCm&);Fl23fMl/j#zx))-oaπU"=r1er?wWmPU;r9*7%cB%:2NWWw%L;FVsS<xVQ7b+8-J.0bu2rAY;J.yshbs<a7MπU"cer9D#uKAlG%d+n-n0&8dY$4uMTm.Wev^vUJk\DZ.36P9N*UQiXN)W=wJr2$uKRπU"0M&:FBN(L-,IT#?Mov&G(2=%?31D%zt0-<J3rh%P8uW9NkQHDz6pmmIWOQux)txπU"&Qtj4DZDrlF>hckV*w>ekpfuxW$8llDZ^>VpAh_hV:*JqU69njXN_=QFHOeJxoSπU"E.?pjs;kJ-VbA.J<k<tQuCFm/>WWEV7#wSM-.Q2gmV=svEZt507=).,>*/W=uLAπU"k3V.=fT6;H-p;UZK?jiBmmhrejj%slP6*l?U9/Md=*7hVih^wZQ8^hG'=Mf*R2-πU"6lZ>Oo:bG1K/KW.nEXt3>[kG8k1.Jh7MofCV5K&T2R_)hIn=J_jNt6],-F5$6o2πU"IZ+_R7#GE7R?eR\Z$P,=R8,=&$B$ko6>)uNK7XP.IDWbXHUk1U6%WE$iP[>Ka(gπU"GAC2x*?A7M-Nr[HF7c+0b7xg6(17WQ17K7DVvyQF>FWLX:u,r456X>*QHluM#oqπU"tLj6#f(wkfYsrxWWOI[b[VGP_Re_#$S6\_CdejX].s?M<4207ItdC5gJfY2HOO)πU"]M)f_>T=]lt^gl:kr$vkH]IAKm3Ctr]nO,M_u04nipNN*Iw22I/W0UxV+&a2Pr6πU"RXxx#X/R(_#mEXZnG*SS(6:iM4PULT4Ypj&_kGab:dfN26$a7KV>uY4-*E[Xh#)πU"T$9mJIL(BG$r$CrgnoalmiE(vxb%51vgqlE?gL(MU;8'Jn83IW[5O3d+7DB5[n/πU"AIZ\;ht6_axJePy-Mm[jjziVIUv?_w&IbV(iJ$88sqoO8cB7HrIxSgnZ+T-)kI?πU"A<otZ+rl3[9Fl+vB7j9H$3:s>DzdM]d8uVGp0hrCf,RLYK>?tnaS^-0ri9\Nc:dπU"%(LhLDBo%C7nK%\]>XR5SGbDi_9Td5(mb$^73&sFyk31[_>A0Xg6YSH3C+h3+L#πU"/s9k#M]v?bqYi:)XQ8*%L/s9+R0vY73#SU\\B.HgccAP*HsqQkel'D_\*Kf(?WUπU"=lq<0XL49ml;nLXqS?K+b?Rmph)a>bIirL>xXd00N\fktVs_XIaXnT^j6tK/t(bπU"IylOq_&bbME(Ja9F&VaguDKA9oLu.AFJr[iaHHg_z4'd3?9VgrFYHCKpj#qIT'sπU"ab.Ks8keG0E_B,,>/&^ZKwEiy:*lvjqaT?0_q##&9.:&zcTUe1O(&<r/DCv#GB0πU"F1FrFA?0%DsD5)Dr(iv$bwRSpkHWa:%Tl/tNv8rQbfrPfMGg>H^VYa.Et*Mmg)sπU"?]xWRH_4G\S[CXcWXa0U4.d(P-c(-Wc('Ib%4k2>RbLFlQe07r.V&hZV/_cG*ueπU"u[D9x5S9j(PKFL]C1\.45Gk$JtU52(c\6Lx[*p>up%&'9%%9%'%.-%#./REab,sπU"DC%.%%6%%%%-%%%%%%%%%&%%E%%%%%%%%.xf%j%Sify%up&'%9%9%%'%-%%%9HBπU"L=>$5'u&%%%v6%%%+%%%%%%%%%&%E%%%%i%%%%xg%Svuh%up&'%9%9%%'%-%/*.πU"RE]R(tl'*'%%&JJ%%%1%%%%%%%%%&%E%.%%3'%%%xu%nsgf%qqSi%fYup%&'9%%πU"9%'%.-%5.nRE**;U<U%.%%o/%%%1%%%%%%%%%&%%E%%%%d*%%%xuns%gfqq%SVUπU"Z%up&'%9%9%%'%-%.q.REF3RMQ&Z&%%%*2%%%1%%%%%%%%%&%E%%%%j+%%%xu%nπU"sgf%qqSi%fFup%&'9%%9%'%%-%u./RE1^91l*&.%%A?%%%1%%%%%%%%%&%%E%%%πU"'s,%%%xuns%gfqq%SifW%up&'%9%9%%'%-%.z.RE<qNuM&f&%%&+Q%%%1%%%%%%πU"%%%&%E%7%%N.%%%xu%nsgf%qqSi%fXup%&'9%%9%'%%-%R.eREY=0VMs/7%%=N%πU"%%+%%%%%%%%%&%%E%%%&e0%%%xgSg%fxup%*+%%%%%-%7-%9&.%%-;%%%%%πEND SUBπCLOSE:IF S=215AND B&=Z&THEN?" :) Ok!"ELSE?" :( Bad!πSUB U(A$):FOR A=1TO LEN(A$):C=ASC(MID$(A$,A))-37:IF C<0THEN C=91+C*32πIF K<4THEN K=C+243ELSE?#1,CHR$(C+(K MOD 3)*86);:K=K\3:B&=B&+1πS=(S+C)AND 255:NEXT:LOCATE,1:?STRING$(B&*50\Z&,219);:END SUBπEric Carr                      SPINBALL GAME UPDATE           FidoNet QUIK_BAS Echo          04-14-96 (20:28)       QB, QBasic, PDS        53   3538     SCROLL.BAS  'HI all! Remember that little Spinball game I posted a couple of days ago??π'Well, I'm thinking about makeing a better version of it..REAL graphics for theπ'backgroud instead of text..smooth scrolling background that is bigger. So farπ'this is all i've made today..I sample of a scrolling background..THIS MUST BEπ'COMPILED or it won't work..because it pokes above the 32767 barrier thing..Useπ'the keypad keys (up, down, left and right) to move it. Numlock MUST be on.π'This is just a simple thing that i spent a couple of hours on, so you can'tπ'press more than one key..it uses that old INKEY$..Hope this helps someone outπ'there!! Also, the file LEVEL1.DAT is the level data file. It's in ASCII so youπ'could edit it with EDIT, just like the levels in my Spinball Game.π                            π DEFINT A-Z:DIM SHARED K,S,B&,Z&:V1 'Created by PostIt! 7.2π SUB V1:OPEN "O",1,"SCROLL.ZIP",4^6:Z&=1758:?STRING$(50,177);πU"%up()%9%'%R-%,K&]ELx<jy((.%%M/%%%/%%%%xh%wtqq%SgfxN&%<>\r]5w5]=πU"N=H*b/E^nSnKTdj6d)G##ys;1QV>Tuwd&AXC1JUYd%$3yrf2h65C3HZlwL;DE$kπU"oWBaEWD30.TC1=T=h]JLPtid1VwVUe)f-^j7Kv-:o,iprN7A/b&Xx>ajC+=$WWfπU"Bb&q,7,m,InRuwvSq+Sbj(NYFt3f1><F,4]i>Th.Bos/ksP<p>&X)iK-2o9_W83πU"/7-?X\F<=6<r)ul_04iBK^e*'&IGOe0_l,o'?.[FOj-12NrZ[+rUg,Zh:?b#B.CπU"+2w4'oPx2jFb9DAhvD>v/0Ye1M%A5k_#TDX4f)oxIwhWuCVpV5VuYi6Uz=;Ad8HπU"aqji)T<NX[>3o(.2QQn5z-/uHlVCnumCjEuL]jdEC-r=up*ob?48t^V(*tVtQ<UπU"?J5^:b)%^lbnY>YwNq0ky[JVAT_RwZT%%i6PV=<b_7zKBooRNrB)eC:qNSS./poπU"+2&1YWo=u\xkIY-&_NTIK,L=bIq<Pn;XYT)):t9%6BSoY\_gFsVJ3Ol0/trpt&cπU"7H4ikOb[KQ5*zGM6zv>]37zmDB.7OzhL^&jN+^ev[rM&Un1nm9xu+RjT]qY9W]OπU"h6;?V[u\#cs2u)F-P),91?K?=1ha6b(>7Wm25\?r[C<KTcB]>/Q'FE03m3\)D(XπU"^aJ?hXDi%C4/YlFU??;?D0bi\8](*X/)N$Yu.Qn-qx)v%WEhso\(eQ=[6fG?[kVπU"GQJ_/EE:Ja>t1Bd1:^ahtgp_Bs=hb/NK*-4\;wBJ2Ut4+1Z)6#x9VrE8^bVp6nJπU")?6Ic,?MvEQ60%A_N3my]6OO3EPb:Xb%tVUzFLGO)V8]C&Z$9eDBDL1$KT\GY:eπU"8RF.viBOPGEIb#s't';#?9mn7CUrAUYT,=D<9\3\ch*p[h)23:M[oe>bupdaC>*πU"i_m*\??tO1keD2+cST-'<I+(K1$I;9+XQyBCoyCGgK[?i663<$2G>Cz]lM9$]DKπU"qxIgDyeH+lb+%]TcbuqmWL/BDRW,^6/*cJfxQ.gtt2axS4-XD=qMDu+Nq:Ug33LπU"N&igTokKr$=HEBCv0Sv-'&?BQKrq$4]&Lt.[JLBo*Af0a?[m-+MOcriYj0*VY='πU"U0\2Tv_;Yf6IS3_0d9?Omq_gn9Xx?D6jiQI/&>7gXI[bLH\g8dH48Khx8NpXn1VπU"vexp\Iqm:Qcm4RthN(6_nN]VkxEn+Aidu%p()9%%'%-I%NI]FEoL9&?u&%%%H+%πU"%%,%%%%gqp%SvuhB^wf=]=U-5alkDs;Td^?KDg?7Z(ftnrLO:?WWdSJ\$[&HaU<πU"78sbWXKJ4tHOCi:2O4bNO+$U%UARvM65e6\<YBJJZjFIX&b>#8N*j=5>uiYwV8EπU"*ud7ZG[(%&o^-#k5W[Qi51<IP2O#KgSUCn)iz,hZ&6$k;jdp$4$%1\dc49LY)sTπU"cCuKUG*MyEw8ol20Aywz];UmN\FFpZ]U5IH093KuV/ns&<8=7cSG_N/BAgt*%blπU"'w).al,Nd;Od?1&8\(00cAC#Bg=sdHiR4A0=q#)bWNFFS8Z^t1NRLAE2ijm?2I)πU"8J((;I5\o4WQOtlh\=W:L5L2G#qB[O,4T%C_NjqGL\OveGl=2;=(J*tt.HS9)nQπU"[N4<#,AhXm=:dchH7j;wpALI.-jmX3KuNSm_j?K(xQ2,^NCubsqw9sqP4%up()%πU"9%'%#-%HLS]EFB7HQ(%7%%<1%%%/%%%%qj&%jqV%Sify-fOV3&TE1+6YVS$]m%1πU"kd78(4u5>Jl?X^>e#y5DcK-1SN:V1K4.0=\[n9W,N8nzTjC#zK;\iG4k_pHeESBπU"c+-W=a6/H'ppq;lgku0G(-T=v[%Sfa:<H6g57EZZ^/96>t,hd4TNq?dsb,Y2(Y:πU"Ox2M0f$-.0QcvA.1ZO>=R34X^>w9wit;g6nqBFZlbK.bAG#hC>gSKm(H/v4nQPuπU"N1GG<#-+LW4u%p&'9%%9%'[%-%,)K]ELjxjy(#(%%M%/%%/%%%%%%%%%&%%E%%%πU"%%%%%%xhw%tqqS%gfxu%p&'9%%9%'%%-%N_I]Eo1L9?u%&%%H%+%%,%%%%%%%%%πU"&%%E%%+%P(%%%gqp%Svuh%up&'%9%9%%'%-%1HL]E*FBHQ'(%%%'<1%%%/%%%%%πU"%%%%&%E%%%%q*%%%qj&%jqV%Sify%up*+%%%%%%(%(%&t%%%%H+%%%%%π END SUBπ CLOSE:IF S=78AND B&=Z&THEN?" :) Ok!"ELSE?" :( Bad!π SUB U(A$):FOR A=1TO LEN(A$):C=ASC(MID$(A$,A))-37:IF C<0THEN C=91+C*32π IF K<4THEN K=C+243ELSE?#1,CHR$(C+(K MOD 3)*86);:K=K\3:B&=B&+1π S=(S+C)AND 255:NEXT:LOCATE,1:?STRING$(B&*50\Z&,219);:END SUBπJoshua Dickerson               TETRIS (TEXT MODE)             FidoNet QUIK_BAS Echo          04-23-96 (00:00)       QB, QBasic, PDS        177  8463     TETRIS.BAS  '               ███████ ██████ ███████ ████   █████  ████π'                  █    █         █    █   █    █   █π'                  █    ████      █    ████     █    ███π'                  █    █         █    █   █    █       █π'                  █    ██████    █    █    █ █████ ████π'π' π'To win,Guide your Piece down the pit and form strait horzontal lines.π'on A-Type you must make 24 Lines.On B-Type you must make 100.On B-typeπ'Every ten lines you pass a level.Turn on NUM-LOCKπ'π'Keys:π' rotate pieceπ'   4 ─5─ 6π'      │π'      2π'Press SHIFT+F5 to playπ'By Joshua Dickersonπ'π'PROGRAMMER'S LOG: 4/23/96 -> I am updating this program for faster execution,π'                             effieciency, and readibility.ππCLS : RANDOMIZE TIMER: DIM Stat(7), Block$(7, 4), B$(4): WIDTH 40πFOR i = 1 TO 7: READ Plength(i): NEXT: FOR i = 1 TO 7: FOR J = 1 TO Plength(i)πREAD Block$(i, J): NEXT: NEXTπPRINT "Use Number Pad to select.Press ENTER to play": PRINTπPRINT " Type:              Level:"πPRINT "┌───────┐          ┌─┬─┬─┬─┬─┬─┬─┬─┬─┬─┐"πPRINT "│>A-Type│          │"; : COLOR 0, 7: PRINT "0"; : COLOR 7, 0πPRINT "│1│2│3│4│5│6│7│8│9│": PRINT "│ B-Type│          └─┴─┴─┴─┴─┴─┴─┴─┴─┴─┘"πPRINT "└───────┘           Hieght": LOCATE 9, 20: PRINT "┌─┬─┬─┬─┬─┬─┬─┬─┬─┬─┐"πLOCATE 10, 20: PRINT "│0│1│2│3│4│5│6│7│8│9│"πLOCATE 11, 20: PRINT "└─┴─┴─┴─┴─┴─┴─┴─┴─┴─┘": Type$ = "A-Type": LOCATE 6, 20πWHILE A$ <> CHR$(13): A$ = INKEY$πIF A$ <> "" THEN LOCATE ASC(Type$) + -59, 2: PRINT " ": LOCATE 6, level * 2 + 21: PRINT USING "#"; levelπIF A$ = "8" THEN Type$ = "A-Type"πIF A$ = "2" THEN Type$ = "B-Type"πIF A$ = "4" AND level > 0 THEN level = level - 1πIF A$ = "6" AND level < 9 THEN level = level + 1πLOCATE ASC(Type$) + -59, 2: PRINT ">": COLOR 0, 7: LOCATE 6, level * 2 + 21πPRINT USING "#"; level: COLOR 7, 0: WEND: IF Type$ = "B-Type" THEN GOTO DisplayπA$ = "": lines = 24: WHILE A$ <> CHR$(13): A$ = INKEY$πIF A$ <> "" THEN LOCATE 10, Hieght * 2 + 21: PRINT USING "#"; HieghtπIF A$ = "4" AND Hieght > 0 THEN Hieght = Hieght - 1πIF A$ = "6" AND Hieght < 9 THEN Hieght = Hieght + 1πLOCATE 10, Hieght * 2 + 21: COLOR 0, 7: PRINT USING "#"; Hieght: COLOR 7, 0πWENDπDisplay: top = 10000πCOLOR 7, 0: CLS : PRINT Type$: PRINT "┌──────────┐"πPRINT "│Statistics│": FOR i = 1 TO 19: PRINT "│          │": NEXTπPRINT "└──────────┘": FOR i = 1 TO 7: LOCATE 1 + i * 3, 8: PRINT "-  0"πFOR J = 1 TO Plength(i): LOCATE J + 3 * i, 2: PRINT Block$(i, J): NEXT: NEXTπFOR J = 2 TO 21: LOCATE J, 15: PRINT "█          █": NEXT: LOCATE 22, 15πPRINT "████████████": LOCATE 1, 16: PRINT "Lines -"; lines: LOCATE 2, 33πPRINT "┌──────┐": FOR i = 3 TO 6: LOCATE i, 33: PRINT "│      │": NEXTπLOCATE 7, 33: PRINT "└──────┘": LOCATE 3, 34: PRINT "Top:": LOCATE 4, 34πPRINT USING "######"; top: LOCATE 5, 34: PRINT "Score:": LOCATE 6, 34πPRINT "     0": LOCATE 8, 35: PRINT "┌────┐": LOCATE 9, 35: PRINT "│Next│"πFOR i = 1 TO 4: LOCATE 9 + i, 35: PRINT "│    │": NEXT: LOCATE 14, 35πPRINT "└────┘": LOCATE 15, 34: PRINT "┌─────┐": LOCATE 16, 34: PRINT "│Level│"πLOCATE 17, 34: PRINT "│ "; USING "##"; level; : PRINT "  │": LOCATE 18, 34πPRINT "└─────┘": NextBlock = 7: NextBlockColor = 1πIF Type$ = "B-Type" THEN GOTO SelectPieceπLOCATE 20, 33: PRINT "┌──────┐": LOCATE 21, 33: PRINT "│Hieght│"πLOCATE 22, 33: PRINT "│  "; USING "##"; Hieght; : PRINT "  │": LOCATE 23, 33πPRINT "└──────┘": LOCATE 22 - Hieght: FOR i = 1 TO Hieght: FOR J = 1 TO 10πLOCATE 22 - i, 15 + JπIF INT(2 * RND(1)) = 1 THEN COLOR INT(15 * RND(1)) + 1: PRINT "█";πNEXT: NEXTπSelectPiece: Collided = 0: Block = NextBlock: BlockColor = NextBlockColorπPbegin = Plength(Block) + 1: row = 1: col = 5πFOR i = 1 TO LEN(Block$(Block, Pbegin - 1)): A$ = MID$(Block$(Block, Pbegin - 1), i, 1)πA = SCREEN(2, 19 + i): IF A = 219 AND A$ = "█" THEN gameover = 1πNEXT: Stat(Block) = Stat(Block) + 1: LOCATE 1 + Block * 3, 9πPRINT USING "###"; Stat(Block): NextBlock = INT(7 * RND(1)) + 1πNextBlockColor = INT(15 * RND(1)) + 1: COLOR NextBlockColor: FOR i = 1 TO 4πLOCATE 9 + i, 36: PRINT "    ": NEXT: FOR i = 1 TO Plength(NextBlock)πLOCATE 9 + i, 36: PRINT Block$(NextBlock, i): NEXT: GOSUB DropPieceπWHILE INKEY$ <> "": WENDπMainLoop:πIF gameover THENπ   FOR i = 40 TO 10 STEP -.5π      SOUND INT(10 * i * RND) + 100, .1π   NEXTπ   FOR i = 21 TO 2 STEP -1π      LOCATE i, 16π      PRINT "▀▀▀▀▀▀▀▀▀▀"π   NEXTπ   ENDπEND IFπIF lines < 1 AND Type$ = "A-Type" THEN LOCATE 12, 17: PRINT "Sucsess!": ENDπIF lines > 99 AND Type$ = "B-Type" THEN LOCATE 12, 17: PRINT "Sucsess!": ENDπt = TIMER: WHILE c$ <> "2" AND TIMER < t + ((10 - level) / 10)πc$ = INKEY$: IF c$ = "4" THEN x = -1: GOSUB MovePieceπIF c$ = "6" THEN x = 1: GOSUB MovePieceπIF c$ = "5" THENπcollision = 0: FOR i = 1 TO 4: B$(i) = "": NEXT: K = 0πFOR i = LEN(Block$(Block, 1)) TO 1 STEP -1: K = K + 1πFOR J = 1 TO Plength(Block): A$ = MID$(Block$(Block, J), K, 1)πB$(i) = B$(i) + A$: NEXT: NEXT: Ptemp = LEN(Block$(Block, 1))πPend = row + Plength(Block) - PbeginπIF Ptemp > Pend THEN Pbtemp = Ptemp - (Pend - 1): Rtemp = 1πIF Ptemp <= Pend THEN Pbtemp = 1: Rtemp = Pend - (Ptemp - 1)πAction = 1: GOSUB DisplayPiece: K = 0: FOR i = Pbtemp TO Ptemp: K = K + 1πFOR J = 1 TO LEN(B$(1)): A$ = MID$(B$(i), J, 1)πA = SCREEN(Rtemp + K, col + J + 14): IF A = 219 AND A$ = "█" THEN collision = 1πNEXT: NEXT: IF col + LEN(B$(1)) > 11 THEN collision = 1πIF collision = 1 THEN Action = 2: GOSUB DisplayPiece: GOTO MainLoopπPlength(Block) = Ptemp: FOR i = 1 TO Ptemp: Block$(Block, i) = B$(i): NEXTπPbegin = Pbtemp: row = Rtemp: Action = 2: GOSUB DisplayPieceπSOUND 900, .3πEND IF: WEND: c$ = "": GOSUB CheckForCollisionπIF Collided = 0 THEN GOSUB DropPiece ELSE SOUND 100, 1: GOSUB EraseLine: GOTO SelectPieceπGOTO MainLoopππCheckForCollision: Collided = 0: K = 0πIF Pbegin <> 1 THEN Pbegin = Pbegin - 1: row = 0πIF row + Plength(Block) = 21 THEN Collided = 1: RETURNπFOR i = Pbegin TO Plength(Block): K = K + 1: FOR J = 1 TO LEN(Block$(Block, 1))πA = SCREEN(row + K + 1, col + J + 14): A$ = MID$(Block$(Block, i), J, 1)πB$ = " ": IF i < Plength(Block) THEN B$ = MID$(Block$(Block, i + 1), J, 1)πIF A = 219 AND A$ = "█" AND B$ = " " THEN Collided = 1πNEXT: NEXT: IF row < 1 THEN row = 1: Pbegin = Pbegin + 1πRETURNππMovePiece: collision = 0: IF col = 1 AND x = -1 THEN RETURNπIF col + LEN(Block$(Block, 1)) = 11 AND x = 1 THEN RETURNπFOR i = 1 TO LEN(Block$(Block, 1)): K = 0: FOR J = Pbegin TO Plength(Block)πK = K + 1: A = SCREEN(row + K, col + i + 14 + x)πA$ = MID$(Block$(Block, J), i, 1): B$ = " "πIF i > 1 AND x = -1 THEN B$ = MID$(Block$(Block, J), i - 1, 1)πIF i < LEN(Block$(Block, 1)) AND x = 1 THEN B$ = MID$(Block$(Block, J), i + 1, 1)πIF A = 219 AND A$ = "█" AND B$ = " " THEN collision = 1πNEXT: NEXT: IF collision = 1 THEN RETURNπAction = 1: GOSUB DisplayPiece: col = col + x: Action = 2: GOSUB DisplayPieceπSOUND 1000, .3: RETURNππDropPiece: Action = 1: GOSUB DisplayPiece: row = row + 1πIF Pbegin > 1 THEN Pbegin = Pbegin - 1: row = 1πAction = 2: GOSUB DisplayPiece: RETURNππDisplayPiece:πCOLOR BlockColorπK = 0πFOR i = Pbegin TO Plength(Block): K = K + 1πFOR J = 1 TO LEN(Block$(Block, 1))π   IF MID$(Block$(Block, i), J, 1) <> " " THENπ      LOCATE row + K, col + J + 14π      IF Action = 1 THEN PRINT " ";  ELSE PRINT CHR$(219);π   END IFπNEXT: NEXT: RETURNππEraseLine: K = 0: add = 500: FOR i = Pbegin TO Plength(Block): K = K + 1πCheck = 0: FOR J = 1 TO 10: Check = Check + SCREEN(row + K, J + 15): NEXTπIF Check = 2190 THENπFOR n = 1 TO 20: SOUND INT(500 * RND) + 100, .1: NEXTπFOR l = row + K TO 3 STEP -1: FOR m = 1 TO 10πCOLOR SCREEN(l - 1, m + 15, 1): LOCATE l, m + 15πPRINT CHR$(SCREEN(l - 1, m + 15)): NEXT: NEXT: LOCATE 2, 16πPRINT "          ": score = score + add: add = add * 2πIF Type$ = "A-Type" THEN lines = lines - 1πIF Type$ = "B-Type" THEN lines = lines + 1: IF INT(lines / 10) > level THEN level = INT(lines / 10)πLOCATE 17, 36: PRINT level: LOCATE 1, 23: PRINT lines: LOCATE 6, 34πPRINT USING "######"; scoreπEND IF: NEXT: RETURNπ'Game A:πDATA 2,2,2,2,2,2,1,"███"," █ ","███","  █","██ "," ██","██","██"," ██","██ "πDATA "███","█  ","████"ππ'Game B:π'DATA 2,1,2,2,2,2,1,"███ "," ███","█ █"," █","█ ","█  ","  █"," █ ", "███","  █"π'DATA "█  ", "████"ππ'Game C:π'DATA 2,2,2,2,2,2,1,"█ █"," █ ","  ██","██  ","█  █","████","█ █","█ █","██"π'DATA " █"," ██ ","████","████"ππEarl L. Montgomery             320X400 SCREEN MODE            FidoNet QUIK_BAS Echo          02-23-96 (17:48)       QB, QBasic, PDS        93   3408     320X400.BAS 'The following post is a program I wrote called 320X400.BAS. It demonstratesπ'how to set up SCREEN 13 320X400X256 mode. It is bare bones. No save or loadπ'routines, other than the routine that saves the screen prior to displaying theπ'HELP menu.If you want to expand on this program please do so! Press H once theπ'program is started for the HELP menu.ππsetmode:π 'Sets SCREEN 13 to the 320X400X256 modeπ SCREEN 13: DEF SEG = &HA000π KEY(10) ONπ ON KEY(10) GOSUB endofprogramπ OUT &H3D4, 9: OUT &H3D5, &H40: OUT &H3D4, 20: OUT &H3D5, 0: OUT &H3D4, 23π OUT &H3D5, &HE3: OUT &H3C4, 4: OUT &H3C5, &H6π OUT &H3C4, 2: OUT &H3C5, 15: CLS : 'rem this clears (CLS) all 4 planesπ IF flag$ = "restart" THEN GOTO loadtempπ OUT &H3C4, 2: OUT &H3C5, 1πbegin:π position% = 15318: c = 15: plane% = 1: OUT &H3C4, 2: OUT &H3C5, 1πrestart:π flag$ = ""π POKE position%, cπwaitkey1:π i$ = INKEY$: IF i$ = "" THEN GOTO waitkey1π i$ = UCASE$(i$)π keycode% = CVI(i$ + CHR$(0))π IF keycode% = 19712 THEN GOTO moverightπ IF keycode% = 19200 THEN GOTO moveleftπ IF keycode% = 18432 THEN GOTO moveupπ IF keycode% = 20480 THEN GOTO movedownπ IF i$ = "C" THEN GOTO changecolorπ IF i$ = "H" THEN GOTO helpscreenπ IF i$ = "X" THEN GOTO clearscreenπ GOTO waitkey1πmoveright:π IF plane% = 1 THEN OUT &H3C4, 2: OUT &H3C5, 2: plane% = 2: GOTO pokescrnπ IF plane% = 2 THEN OUT &H3C4, 2: OUT &H3C5, 4: plane% = 4: GOTO pokescrnπ IF plane% = 4 THEN OUT &H3C4, 2: OUT &H3C5, 8: plane% = 8: GOTO pokescrnπ IF plane% = 8 THEN OUT &H3C4, 2: OUT &H3C5, 1: plane% = 1: position% = position% + 1πpokescrn: IF position% > 31999 THEN position% = 31999π POKE position%, cπ GOTO waitkey1πmoveleft:π IF plane% = 1 THEN OUT &H3C4, 2: OUT &H3C5, 8: plane% = 8: position% = position% - 1: GOTO doitπ IF plane% = 2 THEN OUT &H3C4, 2: OUT &H3C5, 1: plane% = 1: GOTO doitπ IF plane% = 4 THEN OUT &H3C4, 2: OUT &H3C5, 2: plane% = 2: GOTO doitπ IF plane% = 8 THEN OUT &H3C4, 2: OUT &H3C5, 4: plane% = 4:πdoit:π IF position% < 0 THEN position% = 0π POKE position%, cπ GOTO waitkey1πmoveup:π position% = position% - 80π IF position% < 0 THEN position% = position% + 80π POKE position%, cπ GOTO waitkey1πmovedown:π position% = position% + 80π IF position% > 32000 THEN position% = position% - 80π POKE position%, cπ GOTO waitkey1πchangecolor:π c = c + 1π IF c > 255 THEN c = 0π POKE position%, cπ GOTO waitkey1π GOTO waitkey1πhelpscreen:π 'Saving screen before switching to SCREEN 9 and the HELP MENUπ DEF SEG = &HA000π OUT &H3CE, 4: OUT &H3CF, 0: BSAVE "temp1.bin", 0, 32000π OUT &H3CE, 4: OUT &H3CF, 1: BSAVE "temp2.bin", 0, 32000π OUT &H3CE, 4: OUT &H3CF, 2: BSAVE "temp3.bin", 0, 32000π OUT &H3CE, 4: OUT &H3CF, 3: BSAVE "temp4.bin", 0, 32000π SCREEN 9: CLSπ PRINT "Key             Function"π PRINT "Use arrow keys to move cursor"π PRINT "C               Changes current color"π PRINT "F10             Exit Program "π PRINT "H               Help (This Screen)"πwaitkey2:π i$ = INKEY$: IF i$ = "" THEN GOTO waitkey2π CLS : flag$ = "restart": GOTO setmodeπloadtemp:π OUT &H3C4, 2: OUT &H3C5, 1: BLOAD "temp1.bin"π OUT &H3C4, 2: OUT &H3C5, 2: BLOAD "temp2.bin"π OUT &H3C4, 2: OUT &H3C5, 4: BLOAD "temp3.bin"π OUT &H3C4, 2: OUT &H3C5, 8: BLOAD "temp4.bin"π GOTO restartπclearscreen:π OUT &H3C4, 2: OUT &H3C5, 15: CLS : GOTO beginπendofprogram:π SCREEN 0: CLS : DEF SEG : ENDππThomas Gohel                   SCROLLING OVER VGA-BIOS        alt.lang.basic                 03-03-96 (00:00)       PB                     84   2264     VGASCROL.BAS'**************************************************************************π'π'   Scrolling Windows over VGA-BIOS in PowerBASIC 3.0/3.2π'π'   entwickelt von / developed by   :  Thomas Gohelπ'π'                           Fido    :  Thomas Gohel@2:2410/301.12π'                           InterNet:  [e-mail]π'                           Homepage:  http://www.snafu.de/~pbsound/π'π'**************************************************************************ππDIM Demo$(25)πVordergrund% = 15πHintergrund% = 1ππ'*** ErklΣrung ***πSHARED Zol%, Sol%, Zur%, Sur%, Anzahl%, ScrollFarbe%ππ'Zol%    = Zeile oben linksπ'Sol%    = Spalte oben linksπ'Zur%    = Zeile unten rechtsπ'Sur%    = Spalte unten rechtsπ'Anzahl% = Anzahl der zu scrollenden Zeilenπππ'*** String fⁿllen ***πDemo$(1) = "---------    Scrolling windows (over VGA-BIOS)   (c) 1994 Thomas Gohel    ----------"πFOR i% = 2 TO 25π    Demo$(i%) = STRING$(80,65+i%)πNEXT i%ππ'*** String auf Bildschirm ausgeben ***πCOLOR VorderGrund%, Hintergrund%πFOR i% = 1 TO 25π    LOCATE i%,1: PRINT Demo$(i%);πNEXT i%ππ'*** jetzt wird gescrollt ****ππFOR i% = 1 TO 11π    DELAY 0.5π    ScrollFarbe% = Vordergrund% + (Hintergrund% * 16)π    ScrollingHoch     8, 10, 18, 35, 1, ScrollFarbe%π    ScrollingHerUnter 8, 47, 18, 72, 1, ScrollFarbe%π    LOCATE 18, 10: PRINT "  --- Scrolling Hoch ---  "π    LOCATE  8, 47: PRINT " -- Scrolling Herunter -- "πNEXT i%ππENDππFUNCTION ScrollingHoch(BYVAL Zol%, BYVAL Sol%, BYVAL Zur%, BYVAL Sur%, BYVAL Anzahl%, BYVAL ScrollFarbe%)ππ        ! mov ah, &h06π        ! mov al, Anzahl%π        ! mov bh, ScrollFarbe%π        ! mov ch, Zol%π        ! dec chπ        ! mov cl, Sol%π        ! dec clπ        ! mov dh, Zur%π        ! dec dhπ        ! mov dl, Sur%π        ! dec dlπ        ! int &h10ππEND FUNCTIONππFUNCTION ScrollingHerunter(BYVAL Zol%, BYVAL Sol%, BYVAL Zur%, BYVAL Sur%, BYVAL Anzahl%, ByVal ScrollFarbe%)ππ        ! mov ah, &h07π        ! mov al, Anzahl%π        ! mov bh, ScrollFarbe%π        ! mov ch, Zol%π        ! dec chπ        ! mov cl, Sol%π        ! dec clπ        ! mov dh, Zur%π        ! dec dhπ        ! mov dl, Sur%π        ! dec dlπ        ! int &h10ππEND FUNCTIONπChad Beck                      PAC-MAN SCREEN SAVER           Kevin Smith                    03-02-96 (00:00)       QB, QBasic, PDS        215  5578     PACSAVE.BAS ' > Here's...my PacMan Screen Saver....ππ'     I love it!ππ' > Anyone have any suggestions as to how I could make it any better?ππ'     Yep.  This could still be much improved, but it's a start (>15Kπ'smaller than the original).  Hopefully you'll find it easier to read andπ'modify too.  Enjoy!ππ' ******************************************************************π' **  KEVIN SMITH  ********  PACMAN.BAS  *********  JAN 14, 1996  **π' ******************************************************************π' **  PURPOSE:  TO CREATE A PAC-MAN SCREEN SAVER THAT WILL GO IN  **π' **            ALL FOUR DIRECTIONS INSTEAD OF ONLY ONE USING     **π' **            DATA FILES INSTEAD OF REDRAWING ALL THE GRAPHICS  **π' **            EACH TIME THE PROGRAM IS RUN.                     **π' ******************************************************************π'                       Optimized by CHuRL 3-2-96ππDEFINT A-Z                                'Use integers onlyππCONST ArraySize = 242, NumGraphics = 21πCONST Delay = 700                         'Set the delay onceπCONST True = -1, False = NOT TrueπDIM Graphic(0 TO ArraySize * NumGraphics)ππSCREEN 7πCLSπRANDOMIZE TIMERππ'GOSUB MakeData                            '!!!ππDEF SEG = VARSEG(Graphic(0))πON ERROR GOTO MakeDataπ  BLOAD "Pacman.DAT", VARPTR(Graphic(0))πON ERROR GOTO 0                           'I promise it won't crashπ                                          ' from here on...πDirection = 1πX = 160πY = 100πDOπ  IF Turns > NumTurns THENπ    Turns = 0π    Direction = INT(RND * 4)π    NumTurns = INT(RND * 7) + 2π  END IFπ  SELECT CASE Directionπ    CASE 0: GOSUB Rightπ    CASE 1: GOSUB Leftπ    CASE 2: GOSUB Down: Y = 199 - Y - 19π    CASE ELSE: GOSUB Upπ  END SELECTπ  Turns = Turns + 1πLOOP UNTIL INKEY$ = CHR$(27)              'Continue until ESC pressedπSCREEN 0πWIDTH 80πENDππRight:π  FOR Frame = 0 TO 6π    PUT (X, Y), Graphic(Frame * ArraySize), PSETπ    FOR Stall = 0 TO Delay: NEXTπ    IF X < 295 THEN X = X + 1π  NEXTπ  FOR Frame = 6 TO 0 STEP -1π    PUT (X, Y), Graphic(Frame * ArraySize), PSETπ    FOR Stall = 0 TO Delay: NEXTπ    IF X < 295 THEN X = X + 1π  NEXTπ  IF X = 295 THEN NumTurns = 0π  RETURNππLeft:π  FOR Frame = 7 TO 13π    PUT (X, Y), Graphic(Frame * ArraySize), PSETπ    FOR Stall = 0 TO Delay: NEXTπ    IF X > 0 THEN X = X - 1π  NEXTπ  FOR Frame = 13 TO 7 STEP -1π    PUT (X, Y), Graphic(Frame * ArraySize), PSETπ    FOR Stall = 0 TO Delay: NEXTπ    IF X > 0 THEN X = X - 1π  NEXTπ  IF X = 0 THEN NumTurns = 0π  RETURNππDown:π  Y = 199 - Y - 19                        '19 = graphic heightπ  WINDOW (0, 0)-(319, 199)                'Inverse coordinatesπUp:π  FOR Frame = 14 TO 20π    PUT (X, Y), Graphic(Frame * ArraySize), PSETπ    FOR Stall = 0 TO Delay: NEXTπ    IF Y > 0 THEN Y = Y - 1π  NEXTπ  FOR Frame = 20 TO 14 STEP -1π    PUT (X, Y), Graphic(Frame * ArraySize), PSETπ    FOR Stall = 0 TO Delay: NEXTπ    IF Y > 0 THEN Y = Y - 1π  NEXTπ  IF Y = 0 THEN NumTurns = 0π  WINDOW SCREEN (0, 0)-(319, 199)         'Return to normalπ  RETURNππMakeData:π  'Right Pac-Peopleπ  'SCREEN 7, , 1, 0                        '!!!π  FOR X = 1 TO 10π    CIRCLE (20, 20), X, 14π    CIRCLE (21, 20), X, 14π  NEXT Xπ  LINE (20, 14)-STEP(2, 1), 0, BF         'Sketch the eyeπ  GOSUB SaveGraphicππ  LINE (20, 20)-(31, 20), 0π  GOSUB SaveGraphicππ  LINE (20, 20)-(31, 19), 0π  LINE (20, 20)-(31, 21), 0π  GOSUB SaveGraphicππ  LINE (20, 20)-(31, 18), 0π  LINE (20, 20)-(31, 22), 0π  GOSUB SaveGraphicππ  LINE (20, 20)-(31, 17), 0π  LINE (20, 20)-(31, 23), 0π  GOSUB SaveGraphicππ  LINE (20, 20)-(31, 16), 0π  LINE (20, 20)-(31, 24), 0π  GOSUB SaveGraphicππ  LINE (20, 20)-(31, 15), 0π  LINE (20, 20)-(31, 25), 0π  GOSUB SaveGraphicππ  'Left Pac-Peopleπ  FOR X = 0 TO 10π    CIRCLE (20, 20), X, 14π    CIRCLE (21, 20), X, 14π  NEXT Xπ  LINE (20, 14)-STEP(2, 1), 0, BF         'Sketch the eyeπ  GOSUB SaveGraphicππ  LINE (20, 20)-(10, 20), 0π  GOSUB SaveGraphicππ  LINE (20, 20)-(10, 19), 0π  LINE (20, 20)-(10, 21), 0π  GOSUB SaveGraphicππ  LINE (20, 20)-(10, 18), 0π  LINE (20, 20)-(10, 22), 0π  GOSUB SaveGraphicππ  LINE (20, 20)-(10, 17), 0π  LINE (20, 20)-(10, 23), 0π  GOSUB SaveGraphicππ  LINE (20, 20)-(10, 16), 0π  LINE (20, 20)-(10, 24), 0π  GOSUB SaveGraphicππ  LINE (20, 20)-(10, 15), 0π  LINE (20, 20)-(10, 25), 0π  GOSUB SaveGraphicππ  'Up Pac-Peopleπ  FOR X = 1 TO 10π    CIRCLE (20, 20), X, 14π    CIRCLE (21, 20), X, 14π  NEXT Xπ  LINE (14, 19)-STEP(1, 2), 0, BF         'Sketch the eyeπ  GOSUB SaveGraphicππ  LINE (20, 20)-(20, 10), 0π  GOSUB SaveGraphicππ  LINE (20, 20)-(19, 10), 0π  LINE (20, 20)-(21, 10), 0π  GOSUB SaveGraphicππ  LINE (20, 20)-(18, 10), 0π  LINE (20, 20)-(22, 10), 0π  GOSUB SaveGraphicππ  LINE (20, 20)-(17, 10), 0π  LINE (20, 20)-(23, 10), 0π  GOSUB SaveGraphicππ  LINE (20, 20)-(16, 10), 0π  LINE (20, 20)-(24, 10), 0π  GOSUB SaveGraphicππ  LINE (20, 20)-(15, 10), 0π  LINE (20, 20)-(25, 10), 0π  GOSUB SaveGraphicππ  'SCREEN 7, , 0                           '!!!π  'RETURN                                  '!!!ππ  SCREEN 0π  WIDTH 80π  PRINT "CREATING DATA FILE... PLEASE WAIT"π  DEF SEG = VARSEG(Graphic(0))π    BSAVE "Pacman.DAT", VARPTR(Graphic(0)), ArraySize * NumGraphics * 2π  PRINT "DATA FILE CREATED.  YOU MAY NOW RUN THIS PROGRAM AGAIN."π  ENDππSaveGraphic:π  GET (9, 11)-(32, 29), Graphic(Offset)π  Offset = Offset + ArraySizeπ  RETURNπTyler Barnes                   VESA SVGA SCREEN ROUTINES      FidoNet QUIK_BAS Echo          03-10-96 (00:43)       QB, PDS                341  12443    VESA.BAS    '                QuickBasic High Resolution Screen Routinesπ'π'                        By D. Tyler Barnesπ'π'             Works(Hopefully) with any VESA compatible BIOSπ'π'Introπ'~~~~~π'π'        Ok,first of all,I'm not as heavily in to QuickBasic programming asπ'I used to be,so I was a bit lazy writing this. I left a LOT of room forπ'improvement. Second of all,when I WAS in to QuickBasic programming, graphicsπ'was not a specialty. I was more in to communications. The point I'm tryingπ'to make,is that there may be code in this thing that is extraneous,andπ'there may be ways to do what this code is doing a lot faster... Infact,Iπ'KNOW there are ways to make it faster... I'm using the BIOS Write Pixelπ'command in all the graphics commands. It would be much faster done with directπ'writes to video memory.. I'll leave the improvements up to you.π'Just do me a favour and send me your changes so that next time I post this,π'others will recieve these changes. I'll put your name on your code,so don'tπ'worry about me stealing your credit...π'Oh,another weird thing I've done,is I've used InterruptX almost everywhere,π'even in places where INTERRUPT would've worked. As far as I know they areπ'identical anyhow,'cept INTERRUPTX can use more registers... but perhapsπ'I'm wrong. Perhaps INTERRUPT is faster or something. Go ahead and change it.π'π'How to useπ'~~~~~~~~~~π'π'* Before doing anything,make sure you've loaded QuickBasic with theπ'  /L switch.π'* Next detect whether or not the machine has VESA compatibilityπ'* Set the screen modeπ'* Write the program hereπ'* Use the CleanUp commandπ'* Endπ'π'Commands:π'π'Border-This command is used when in text mode,and some graphic modes.π'         It has one integer parameter. Depending what screen mode you're in,π'         and what number you use,this will change the screen colour,theπ'         border,both,or neither. Just mess around with it ...π'         Example Usage:Border 9π'         On my machine,the above will produce a light blue border when inπ'         ScreenMode 3(Basic's SCREEN 0)π'Box-This command will not work in any text modes.(Obviously)π'      It has 5 parameters. 4 to define the box,and the last to define theπ'      colour of the box.π'      Example Usage:Box 10,11,50,51,3π'      The above command would make a box with the left hand corner  on pointπ'      10,11(X,Y) and the bottom right hand corner on 50,51.π'      The last parameter is the colour and will have a different resultπ'      depending on your screen mode.π'CleanUp-This command is used to clean up after the ScreenMode command. Itπ'          should be run before you exit your program. Also,if you haveπ'          allready run ScreenMode once,and you want to change to a newπ'          screen mode,you'll have to run this before doing so. Also,if youπ'          want to stop using these routines,and use BASIC's routines instead,π'          and ScreenMode has allready been used in your program,you'll haveπ'          to run this before using BASIC's SCREEN command.π'          Example Usage:CleanUpπ'CurVidMode-This function will return the current video mode. The numberπ'             returned will not always correspond with the number used in theπ'             ScreenMode command,and will not always correspond with BASIC'sπ'             SCREEN mode. If you want to see what the number returned means,π'             look up AH=00,INT 10h in Ralf Brown's interrupt list.π'             Example Usage:A%=CurVidMode%π'LowHigh-Crappy way of seperating two seperate bytes from a word. If youπ'          don't know what I'm talking about,don't worry about it. The onlyπ'          reason I have this in here at all,is because there are otherπ'          routines in this source that depend on it.π'Pixel-This is like BASIC's PSET command. It plots one pixel on to theπ'        display. There are three parameters. Two for the X,Y coordinates ofπ'        the dot,and one for the colour.π'        Example Usage:Pixel 5,10,2π'        The above command would plot a pixel at 5,10(X,Y) with a colourπ'        value of 2.π'        This command will not work in text modes.π'        Pixel Positions start at 0,0.π'ScreenMode-This is used to switch between the screen modes. Please lookπ'             up the CLEANUP command after reading this explanation.π'             This command has one parameter;the screen mode.π'             Example Usage:ScreenMode 3π'             The above command would switch the computer into 80x25x16 textπ'             mode.(80 columns,25 rows,16 colours)π'             So that you don't have to remember all the numbers,I built inπ'             a bunch of constants to use for the more common modes. Of course,π'             there are always modes I left out that may work,so experiment.π'             If you find a mode that you want to use,try it on more thanπ'             one machine to make sure that the mode you've selected isπ'             fairly compatible. Oh,and be careful. I've heard that withπ'             older equipment,you can actually fry your monitor by going intoπ'             certain unsupported modes.π'VesaSupported-This function is used to detect whether or not the machineπ'                that the program is running on has VESA compatibility.π'                Example Usage:IF VesaSupported THENπ'                          Ie2:IF NOT VesaSupported THENππDECLARE SUB Box (TopX%, TopY%, BottomX%, BottomY%, Colour%)πDECLARE SUB Pixel (X%, Y%, Colour%)πDECLARE SUB Border (Colour%)πDECLARE FUNCTION Curvidmode% ()πDECLARE FUNCTION Readpixel% (Column%, Row%)πDECLARE SUB Cleanup ()πDECLARE SUB Tlocate (Y%, X%)πDECLARE SUB Tcolour (ForeGround%, BackGround%)πDECLARE SUB ScreenMode (MODE%)πDECLARE FUNCTION Vesasupported% ()πDECLARE SUB LowHigh (Register%, low%, High%)ππTYPE SVGAπ    Sig AS STRING * 4π    Version AS INTEGERπ    OEMPtr AS LONGπ    Capibilities AS STRING * 4π    ListPtr AS LONGπ    VidMem AS INTEGERπ    Reserved AS STRING * 262πEND TYPEππ'$INCLUDE: 'QB.BI'πDIM SHARED Inregx AS RegTypeX, Outregx AS RegTypeXπCONST GM640x400x256 = &H100, GM640x480x256 = &H101, GM800x600x16 = &H102πCONST GM800x600x256 = &H103, GM1024x768x16 = &H104, GM1024x768x256 = &H105πCONST TM80X25 = 3πCLSπIF NOT Vesasupported THENπ    PRINT "Fatal Error: VESA was not detected."πEND IFπ'Y=0 to 767π'X=0 to 1023πScreenMode GM1024x768x256πColour = -.5πFOR X% = 0 TO 1023π    Colour = Colour + .5π    IF INT(Colour) > 255 THEN Colour = -.5π    FOR Y% = 0 TO 767π       Pixel X%, Y%, INT(Colour)π    NEXT Y%π    IF LEN(INKEY$) > 0 THEN GOTO HereπNEXT X%ππHere:πBox 50, 50, 390, 590, 2πWHILE INKEY$ = "": WENDπ    CleanupπDEFINT A-ZππDEFSNG A-ZπSUB Border (Colour%)π    DIM inreg AS RegType, outreg AS RegTypeπ    'In Text mode(3) you can only set the border colour.π    'With some video modes this will also modify the background colourπ    'With other video modes,this may not work at all.π    IF Colour% > 255 THEN Colour% = 255π    IF Colour% < 0 THEN Colour% = 0π    inreg.AX = &HB00π    inreg.BX = Colour%π    CALL INTERRUPT(&H10, inreg, outreg)πEND SUBππDEFINT A-ZπSUB Box (TopX, TopY, BottomX, BottomY, Colour%)π    FOR I% = TopX TO BottomX STEP 1π       Pixel I%, TopY, Colour%π       Pixel I%, BottomY, Colour%π    NEXT I%π    FOR I% = TopY TO BottomY STEP 1π       Pixel BottomX, I%, Colour%π       Pixel TopX, I%, Colour%π    NEXT I%πEND SUBππSUB Cleanupπ    SHARED StartingModeπ    Inregx.AX = StartingModeπ    CALL interruptx(&H10, Inregx, Outregx)πEND SUBππDEFSNG A-ZπFUNCTION Curvidmode%π    DEF SEG = &H40π    Curvidmode% = PEEK(&H49)π    DEF SEGπEND FUNCTIONππDEFINT A-ZπSUB GPrint (Text$)π    SHARED Col%π    Inregx.AX = &H300π    CALL interruptx(&H10, Inregx, Inregx)π    Inregx.AX = &H1301π    Inregx.BX = Col%π    Inregx.CX = LEN(Text$)π    Inregx.ES = VARSEG(Text$)π    Inregx.BP = SADD(Text$)π    CALL interruptx(&H10, Inregx, Outregx)πEND SUBππDEFSNG A-ZπSUB LowHigh (Register%, low%, High%)π    Full$ = HEX$(Register%)π    IF LEN(Full$) < 4 THENπ       WHILE LEN(Full$) < 4: Full$ = "0" + Full$: WENDπ       END IFπ       low% = VAL("&H" + RIGHT$(Full$, 2))π       High% = VAL("&H" + LEFT$(Full$, 2))πEND SUBππSUB Makecircle (X%, Y%, Rad, Colour%)π    FOR I = 0 TO 6.4 STEP .005π       Pixel INT(Rad * COS(I)) + X%, INT(Rad * SIN(I)) + Y%, Colour%π    NEXT IπEND SUBππDEFINT A-ZπSUB MakeLine (A, B, C, D, Colour%)π    U = C - A: v = D - B: Param = U: GOSUB Sign: D1X = Signπ    Param = v: GOSUB Sign: D1Y = Sign: Param = U: GOSUB Sign: D2X = Signπ    D2Y = 0: m = ABS(U): N = ABS(v)π    IF m <= N THENπ       D2X = 0: Param = v: GOSUB Sign: D2Y = Sign: m = ABS(v): N = ABS(U)π    END IFπ    S% = m / 2π    FOR I% = 0 TO mπ       Pixel A, B, Colour%: S% = S% + Nπ       IF S% >= m THENπ          S% = S% - m: A = A + D1X: B = B + D1Yπ       ELSEπ          A = A + D2X: B = B + D2Yπ       END IFπ    NEXT I%π    EXIT SUBπSign:π    SELECT CASE Paramπ       CASE IS > 0: Sign = 1π       CASE IS < 0: Sign = -1π       CASE 0: Sign = 0π    END SELECTπ    RETURNπEND SUBππDEFSNG A-ZπSUB Pixel (X%, Y%, Colour%)π    DIM inreg AS RegType, outreg AS RegTypeπ    C$ = HEX$(Colour%)π    LC% = LEN(C$)π    IF LC% < 2 THEN C$ = "0" + C$π    IF LC% > 2 THEN C$ = LEFT$(C$, 2)π    inreg.AX = VAL("&HC" + C$)π    inreg.BX = &H0π    inreg.DX = Y%π    inreg.CX = X%π    CALL INTERRUPT(&H10, inreg, outreg)πEND SUBππDEFINT A-ZπFUNCTION Readpixel (Column, Row)π    Inregx.AX = &HD00π    Inregx.BX = 0π    Inregx.CX = Columnπ    Inregx.DX = Rowπ    CALL interruptx(&H10, Inregx, Outregx)π    LowHigh Outregx.AX, RP, Junkπ    Readpixel = RPπEND FUNCTIONππSUB ScreenMode (MODE%)π    SHARED StartingModeπ    Inregx.AX = &HF00π    CALL interruptx(&H10, Inregx, Outregx)π    LowHigh Outregx.AX, StartingMode, Columnsπ    Inregx.AX = &H4F03π    CALL interruptx(&H10, Inregx, Outregx)π    LowHigh Outregx.AX, Support, Statusπ    IF Status <> 0 OR Support <> &H4F THEN ERROR (5)π    StartingVesaMode = Outregx.BXπ    Inregx.AX = &H4F02π    Inregx.BX = MODE%π    CALL interruptx(&H10, Inregx, Outregx)π    LowHigh Outregx.AX, Support, Statusπ    IF Support <> &H4F OR Status <> 0 THEN ERROR (5)π    Inregx.AX = &HF00π    CALL interruptx(&H10, Inregx, Outregx)π    LowHigh Outregx.AX, EndResult, Columnsπ    Inregx.AX = &H4F02π    Inregx.BX = StartingVesaModeπ    CALL interruptx(&H10, Inregx, Outregx)π    IF Support <> &H4F OR Status <> 0 THEN ERROR (5)π    Inregx.AX = EndResultπ    CALL interruptx(&H10, Inregx, Outregx)π    Tcolour 7, 0: Tlocate 1, 1πEND SUBππSUB Tcolour (ForeGround, BackGround)π    SHARED Col%π    T$ = HEX$(ForeGround): T2$ = HEX$(BackGround)π    IF LEN(T$) > 1 OR LEN(T2$) > 1 THEN ERROR (5)π    Col% = VAL("&H" + T2$ + T$)πEND SUBππSUB Tlocate (Y, X)π    Y = Y - 1: X = X - 1π    Y$ = HEX$(Y): X$ = HEX$(X)π    IF LEN(Y$) > 2 OR LEN(X$) > 2 THEN ERROR (5)π    IF LEN(Y$) < 2 THEN Y$ = "0" + Y$π    IF LEN(X$) < 2 THEN X$ = "0" + X$π    Inregx.AX = &H200π    CurLoc% = VAL("&H" + Y$ + X$)π    Inregx.DX = CurLoc%π    CALL interruptx(&H10, Inregx, Outregx)π    X = X + 1: Y = Y + 1πEND SUBππFUNCTION Vesasupportedπ    DIM VInfoBuff AS SVGAπ    Inregx.AX = &H4F00π    Inregx.ES = VARSEG(VInfoBuff)π    Inregx.di = VARPTR(VInfoBuff)π    CALL interruptx(&H10, Inregx, Outregx)π    LowHigh Outregx.AX, Support, Statusπ    IF UCASE$(VInfoBuff.Sig) <> "VESA" OR Support <> &H4F OR Status <> 0 THENπ       Vesasupported = 0π    ELSEπ       Vesasupported = -1π    END IFπEND FUNCTIONππ'Oh, that's it. And after all that commenting, I still neglected to say a fewπ'things. First of all, if you try to switch to a screen mode that isn'tπ'supported by your computer, most of the time it will give you an Illegalπ'Function Call... Of course there are a few modes that won't be detected asπ'invaid, they'll just freeze the machine or something not so nice.π'Also, In the VesaDetection function I'm using a TYPE instead of just a largeπ'set-length string... a large set length string would eliminate the TYPE stuffπ'at the top of the file, but I put it the way i did incase someone wanted toπ'use the info to add stuff. After all this time I've wasted talking abut thisπ'thing, I sure hope it works... <G> .. I still haven't tested it on any machineπ'but my own.L8r,π'D. Tyler BarnesπManny Najera                   QBASIC FADING ROUTINE          www.flashgames.com             03-09-96 (23:20)       QB, QBasic, PDS        108  2531     QBFADE.BAS  'QBasic FADEing - The real thing.π'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~π'From Manny Najera of Flash Gamesπ'--------------------------------π'   http://www.flashgames.comπ'--------------------------------ππ'How To Use This Stuffπ'---------------------π'To fade out, just use PALETTE.FADEOUT.π'PALETTE.FADEIN will work after you fadeout.π'If you mess around with the pData array inπ'between, it won't work correctly.  All theπ'other subs you don't have to worry about.π'The FLICKERING?  Its not as bad as before.π'Live with it.  It happens to the best of us.π'Use this code NOW!  I'm tired of looking atπ'those fake fades.ππDEFINT A-Zππ'Just add this into your program.π'---------------------------------πTYPE PaletteTypeπRed AS INTEGERπGreen AS INTEGERπBlue AS INTEGERπEND TYPEπDECLARE SUB Palette.Set (nColor%, pInfo AS PaletteType)πDECLARE SUB Palette.Get (nColor%, pInfo AS PaletteType)πDECLARE SUB Palette.Fadeout ()πDECLARE SUB Palette.FadeIn ()πDIM SHARED Pal AS PaletteTypeπDIM SHARED pData(0 TO 255, 1 TO 3)π'---------------------------------ππSCREEN 13πFOR I = 0 TO 200πLINE (0, I)-(319, I), IπNEXT IπSLEEPπPalette.FadeoutπSLEEPπPalette.FadeInππSUB Palette.FadeInπDIM tT(1 TO 3)πFOR I = 1 TO 64πWAIT &H3DA, 8π  FOR O = 0 TO 255π    Palette.Get O, Palπ    tT(1) = Pal.Redπ    tT(2) = Pal.Greenπ    tT(3) = Pal.Blueπ    IF tT(1) < pData(O, 1) THEN tT(1) = tT(1) + 1π    IF tT(2) < pData(O, 2) THEN tT(2) = tT(2) + 1π    IF tT(3) < pData(O, 3) THEN tT(3) = tT(3) + 1π    Pal.Red = tT(1)π    Pal.Green = tT(2)π    Pal.Blue = tT(3)π    Palette.Set O, Palπ  NEXT OπNEXT IππEND SUBππSUB Palette.FadeoutπDIM tT(1 TO 3)πFOR I = 0 TO 255π  Palette.Get I, Palπ  pData(I, 1) = Pal.Redπ  pData(I, 2) = Pal.Greenπ  pData(I, 3) = Pal.BlueπNEXT IπFOR I = 1 TO 64πWAIT &H3DA, 8π  FOR O = 0 TO 255π    Palette.Get O, Palπ    tT(1) = Pal.Redπ    tT(2) = Pal.Greenπ    tT(3) = Pal.Blueπ    IF tT(1) > 0 THEN tT(1) = tT(1) - 1π    IF tT(2) > 0 THEN tT(2) = tT(2) - 1π    IF tT(3) > 0 THEN tT(3) = tT(3) - 1π    Pal.Red = tT(1)π    Pal.Green = tT(2)π    Pal.Blue = tT(3)π    Palette.Set O, Palπ  NEXT OπNEXT IπEND SUBππSUB Palette.Get (nColor%, pInfo AS PaletteType)πOUT &H3C6, &HFFπOUT &H3C7, nColor%πpInfo.Red = INP(&H3C9)πpInfo.Green = INP(&H3C9)πpInfo.Blue = INP(&H3C9)πEND SUBππSUB Palette.Set (nColor%, pInfo AS PaletteType)πOUT &H3C6, &HFFπOUT &H3C8, nColor%πOUT &H3C9, pInfo.RedπOUT &H3C9, pInfo.GreenπOUT &H3C9, pInfo.BlueπEND SUBππDavid Carlton                  3D-VR MAZE WARS                [e-mail]            03-09-96 (23:31)       QB, QBasic, PDS        429  12815    MAZEWARS.BASREM   Alpha version of VR Maze Wars (working title) by David CarltonπREM   Hard Core Software  Copyright 1995ππREM   This is the alpha version of my game! Basically it's a super slowπREM   qbasic version of my program only allowing you to wander around aπREM   small room. This actually looks barely anything like the actual gameπREM   will. This has clear walls and no hit detection for the objects inπREM   the center of the room. Also, because this has no object sorting,πREM   close walls will dissapear. Of course the worst thing about the alphaπREM   is how terribly slow it runs in non-compiled qbasic. Most of the timeπREM   you will have to wait about 5 seconds for each frame to be drawn.ππREM   Below is a list of features that will be in the finished version orπREM   later upgrades:ππREM   -Written in C++:over ten times fasterπREM   -Runs in WindowsπREM   -SVGA or VGA graphicsπREM   -Digital sound effects and midi musicπREM   -Full 6DOF enviroment (jumping,strafing,look up-down  the works!)πREM   -Texture mapped surfacesπREM   -Gourad/ray traced shading and light effectsπREM   -Multiple camerasπREM   -Weapons like homing missle launchers and artillery cannonsπREM   -Helpful powerups like 180 degree vision and jet packsπREM   -Lots of enemiesπREM   -Liquid surfaces (dive underwater)πREM   -Modem playπREM   -Large and a-maze-ing levelsπREM   -More cool stuff like level editors and cheatsππREM   This alpha version is a long ways away from the finished versionπREM   described above, but I'm working on it. Not all of these features mayπREM   get included in the first version, but I'll try to squeeze in all thatπREM   I can. I plan to release it as shareware, and include more levels,πREM   weapons, enemies, and sound effects if it is registered.ππREM   I tried to spend as little time as possible working on this alphaπREM   because of the problems and limitations of qbasic. Thus, you can't doπREM   too much in this program. Use the arrow keys to move around, and q toπREM   quit. I also added b for bird's eye view and n for normal view. I mightπREM   use something like that as a map in later versions. Ready? Press F5πREM   to start. If you have any suggestions write me on the internet atπREM   "[e-mail]".πππREM   P.S.  If you want to see this program run in high resolution, changeπREM   the lines that say  SCREEN 8, , drawnpage, shownpage  to  SCREEN 12 andπREM   maxy and screeny to 479 in the line just below the first SCREENπREM   statement. This will disable multiple pages but allow 640x480 graphics.ππππON ERROR GOTO 1π1 RESUME NEXTππREM initializationππDIM template(3, 6, 4, 3), objectloc(37, 3), objectrot(37, 3), objecttype(37)πDIM playerloc(3), playerrot(3), playervel(3), surfacenumber(3), vertexnumber(3, 6)ππshownpage = 1: drawnpage = 0πCOLOR 7πSCREEN 8, , drawnpage, shownpageπperspective = 600πwalkspeed = 5πmaxx = 639: minx = 1: maxy = 199: miny = 1πscreenx = 639: screeny = 199ππREM reading data routineππREM This should read out of a data file in later versionsππFOR i = 1 TO 3πREAD playerloc(i)πNEXT iπFOR j = 1 TO 3πREAD playerrot(j)πNEXT jπFOR k = 1 TO 3πREAD playervel(k)πNEXT kππREAD templatenumberπFOR i = 1 TO templatenumberπREAD surfacenumber(i)πFOR j = 1 TO surfacenumber(i)πREAD vertexnumber(i, j)πFOR k = 1 TO vertexnumber(i, j)πFOR l = 1 TO 3πREAD template(i, j, k, l)πNEXT lπNEXT kπNEXT jπNEXT iππREAD objectnumberπFOR i = 1 TO objectnumberπREAD objecttype(i)πFOR j = 1 TO 3πREAD objectloc(i, j)πNEXT jπFOR k = 1 TO 3πREAD objectrot(i, k)πNEXT kπNEXT iππREM  keyboard scan routineππREM This is the central routine in this version of the game, but it shouldn'tπREM be in later versions.ππGOSUB 100ππDOππin$ = INKEY$πIF RIGHT$(in$, 1) = CHR$(72) THEN vectorvel = walkspeed: GOSUB 50πIF RIGHT$(in$, 1) = CHR$(80) THEN vectorvel = walkspeed * (-1): GOSUB 50πIF RIGHT$(in$, 1) = CHR$(77) THEN playerrot(1) = playerrot(1) - .26799πIF RIGHT$(in$, 1) = CHR$(75) THEN playerrot(1) = playerrot(1) + .26799πIF playerrot(1) > 6.28 THEN playerrot(1) = playerrot(1) - 6.28πIF playerrot(1) < 0 THEN playerrot(1) = playerrot(1) + 6.28πIF in$ = "q" THEN gameover = 1: ENDπIF in$ = "b" THEN playerloc(2) = 100: playerrot(3) = 1.54πIF in$ = "n" THEN playerloc(2) = 0: playerrot(3) = 3.14πIF RIGHT$(in$, 1) <> CHR$(72) AND RIGHT$(in$, 1) <> CHR$(80) THEN GOSUB 55ππREM   IF in$ <> "" OR playervel(1) <> 0 OR playervel(3) <> 0 THEN CLS 1: GOSUB 100ππIF in$ <> "" THEN CLS 1: GOSUB 100ππin$ = ""ππLOOP WHILE gameover = 0ππENDππREM  vector movement converted to cartesianππ50ππREM x velocityπplayervel(1) = playervel(1) + SIN(playerrot(1)) * vectorvelπREM z velocityπplayervel(3) = playervel(3) - COS(playerrot(1)) * vectorvelππplayervel(1) = INT(playervel(1)): playervel(3) = INT(playervel(3))ππIF playervel(1) > 4 THEN playervel(1) = 4πIF playervel(1) < -4 THEN playervel(1) = -4πIF playervel(3) > 4 THEN playervel(1) = 4πIF playervel(3) < -4 THEN playervel(3) = -4ππplayerloc(1) = playerloc(1) + playervel(1)πplayerloc(3) = playerloc(3) + playervel(3)ππREM customized hit detection -- cheapππIF playerloc(1) < 0 THEN playerloc(1) = 0πIF (playerloc(3) <= 30 OR playerloc(3) >= 40) AND playerloc(1) > 60 THEN playerloc(1) = 60πIF playerloc(1) > 80 THEN playerloc(1) = 80ππIF playerloc(3) < 0 THEN playerloc(3) = 0πIF playerloc(3) > 70 THEN playerloc(3) = 70πIF playerloc(1) >= 60 AND playerloc(3) < 30 THEN playerloc(3) = 30πIF playerloc(1) >= 60 AND playerloc(3) > 40 THEN playerloc(3) = 40ππRETURNππREM  frictionππ55 REM  I disabled gliding because it isn't very effective when the programπREM     runs this slow.ππIF playervel(1) > 0 THEN playervel(1) = playervel(1) - 4πIF playervel(1) < 0 THEN playervel(1) = playervel(1) + 4πIF playervel(3) > 0 THEN playervel(3) = playervel(3) - 4πIF playervel(3) < 0 THEN playervel(3) = playervel(3) + 4ππRETURNππREM  main graphics routine (large)ππ100πππFOR i = 1 TO objectnumberπFOR j = 1 TO surfacenumber(objecttype(i))ππGOSUB 2000ππx = template(objecttype(i), j, 1, 1): y = template(objecttype(i), j, 1, 2): z = template(objecttype(i), j, 1, 3)πGOSUB 3000πx1 = x: y1 = y: z1 = zππx = template(objecttype(i), j, 2, 1): y = template(objecttype(i), j, 2, 2): z = template(objecttype(i), j, 2, 3)πGOSUB 3000πx2 = x: y2 = y: z2 = zππx = template(objecttype(i), j, 3, 1): y = template(objecttype(i), j, 3, 2): z = template(objecttype(i), j, 3, 3)πGOSUB 3000πx3 = x: y3 = y: z3 = zππGOSUB 7000πIF sp < 0 THEN GOTO 105ππx = template(objecttype(i), j, 1, 1): y = template(objecttype(i), j, 1, 2): z = template(objecttype(i), j, 1, 3)πGOSUB 3000πGOSUB 4000πsxa = sx: sya = syππx = template(objecttype(i), j, 2, 1): y = template(objecttype(i), j, 2, 2): z = template(objecttype(i), j, 2, 3)πGOSUB 3000πGOSUB 4000πsxb = sx: syb = syππGOSUB 5000πIF drawit = 1 THEN LINE (sxa, sya)-(sxb, syb)ππx = template(objecttype(i), j, 2, 1): y = template(objecttype(i), j, 2, 2): z = template(objecttype(i), j, 2, 3)πGOSUB 3000πGOSUB 4000πsxa = sx: sya = syππx = template(objecttype(i), j, 3, 1): y = template(objecttype(i), j, 3, 2): z = template(objecttype(i), j, 3, 3)πGOSUB 3000πGOSUB 4000πsxb = sx: syb = syππGOSUB 5000πIF drawit = 1 THEN LINE (sxa, sya)-(sxb, syb)ππFOR k = 3 TO vertexnumber(objecttype(i), j)πIF k = vertexnumber(objecttype(i), j) THENππ   x = template(objecttype(i), j, 1, 1): y = template(objecttype(i), j, 1, 2): z = template(objecttype(i), j, 1, 3)π   GOSUB 3000π   GOSUB 4000π   sxa = sx: sya = syπ  π   x = template(objecttype(i), j, k, 1): y = template(objecttype(i), j, k, 2): z = template(objecttype(i), j, k, 3)π   GOSUB 3000π   GOSUB 4000π   sxb = sx: syb = syπ  π   GOSUB 5000π   IF drawit = 1 THENπ     LINE (sxa, sya)-(sxb, syb)π   END IFππELSEπ  π   x = template(objecttype(i), j, k + 1, 1): y = template(objecttype(i), j, k + 1, 2): z = template(objecttype(i), j, k + 1, 3)π   GOSUB 3000π   GOSUB 4000π   sxa = sx: sya = syπ  π   x = template(objecttype(i), j, k, 1): y = template(objecttype(i), j, k, 2): z = template(objecttype(i), j, k, 3)π   GOSUB 3000π   GOSUB 4000π   sxb = sx: syb = syπ  π   GOSUB 5000π   IF drawit = 1 THENπ     LINE (sxa, sya)-(sxb, syb)π   END IFπEND IFπNEXT kπ105 NEXT jπNEXT iππREM switch pagesππdrawnpage = 1 - drawnpageπshownpage = 1 - shownpageπSCREEN 8, , drawnpage, shownpageππRETURNππ2000ππREM sin and cos factorsππREM playerπsr1 = SIN(playerrot(1)): sr2 = SIN(playerrot(2)): sr3 = SIN(playerrot(3))πcr1 = COS(playerrot(1)): cr2 = COS(playerrot(2)): cr3 = COS(playerrot(3))ππREM object -- adding "o" at the end is cheapππsro1 = SIN(objectrot(i, 1)): sro2 = SIN(objectrot(i, 2)): sro3 = SIN(objectrot(i, 3))πcro1 = COS(objectrot(i, 1)): cro2 = COS(objectrot(i, 2)): cro3 = COS(objectrot(i, 3))ππRETURNππ3000 REM 3-d formulasππREM objectππx = (-1) * x: xa = cro1 * x - sro1 * zπza = sro1 * x + cro1 * z: x = cro2 * xa + sro2 * yπya = cro2 * y - sro2 * xa: z = cro3 * za - sro3 * yaπy = sro3 * za + cro3 * yaππx = x + objectloc(i, 1): y = y + objectloc(i, 2): z = z + objectloc(i, 3)ππREM playerππx = x - playerloc(1): y = y - playerloc(2): z = z - playerloc(3)ππx = (-1) * x: xa = cr1 * x - sr1 * zπza = sr1 * x + cr1 * z: x = cr2 * xa + sr2 * yπya = cr2 * y - sr2 * xa: z = cr3 * za - sr3 * yaπy = sr3 * za + cr3 * yaππsx = perspective * x / z: sy = perspective * y / zππREM cheap-o 3-d line clipping (That's why things look strange sometimes)ππdrawit = 1πIF z <= 10 THEN drawit = 0πππRETURNππ4000ππREM 2-d cartesian to 2-d physicalππsx = sx + 399: sy = sy + 299: rx = screenx / 799: ry = screeny / 599πsx = sx * rx: sy = sy * ryππRETURNπππ5000ππREM 2-d line clippingπππIF sxa > sxb THEN tempswap = sxa: sxa = sxb: sxb = tempswap: tempswap = sya: sya = syb: syb = tempswapπIF sxa < minx AND sxb < minx THEN drawit = 0: RETURNπIF sxa > maxx AND sxb > maxx THEN drawit = 0: RETURNπIF sya < miny AND syb < miny THEN drawit = 0: RETURNπIF sya > maxy AND syb > maxy THEN drawit = 0: RETURNπIF sxa < minx THEN c = (syb - sya) / (sxb - sxa) * (sxb - minx) ELSE GOTO 5010π                    sxa = minx: sya = syb - cπ                    IF sya < miny AND syb < miny THEN drawit = 0: RETURNπ                    IF sya > maxy AND syb > maxy THEN drawit = 0: RETURNππ5010  IF sxb > maxx THEN c = (syb - sya) / (sxb - sxa) * (maxx - sxa) ELSE GOTO 5020π                    sxb = maxx: syb = sya + cπ                    IF sya < miny AND syb < miny THEN drawit = 0: RETURNπ                    IF sya > maxy AND syb > maxy THEN drawit = 0: RETURNππ5020 IF sya > syb THEN tempswap = sxa: sxa = sxb: sxb = tempswap: tempswap = sya: sya = syb: syb = tempswapπIF sya < miny THEN c = (sxb - sxa) / (syb - sya) * (syb - miny): sxa = sxb - c: sya = minyπIF syb > maxy THEN c = (sxb - sxa) / (syb - sya) * (maxy - sya): sxb = sxa + c: syb = maxyππRETURNππ7000ππREM plane-equation method of hidden surface removalππsp1 = x1 * (y2 * z3 - y3 * z2): sp1 = (-1) * sp1: sp2 = x2 * (y3 * z1 - y1 * z3)πsp3 = x3 * (y1 * z2 - y2 * z1): sp = sp1 - sp2 - sp3ππRETURNπππREM player dataππDATA 5,0,0,  2.796129,0,3.14,  0,0,0ππREM templatesππDATA 3ππREM template:cubeππDATA 6, 4, 5,5,5, 5,5,-5, -5,5,-5, -5,5,5,  4, 5,-5,5, 5,5,5, -5,5,5, -5,-5,5πDATA 4, 5,-5,-5, 5,5,-5, 5,5,5, 5,-5,5,  4, -5,-5,-5, -5,5,-5, 5,5,-5, 5,-5,-5πDATA    4, -5,-5,5, -5,5,5, -5,5,-5, -5,-5,-5πDATA    4, -5,-5,5, -5,-5,-5, 5,-5,-5, 5,-5,5ππREM template:pyramidππDATA 5, 3, 5,-5,5, 0,10,0, -5,-5,5,  3, 5,-5,-5, 0,10,0, 5,-5,5πDATA    3, -5,-5,5, 0,10,0, -5,-5,-5,  3, -5,-5,-5, 0,10,0, 5,-5,-5πDATA    4, -5,-5,5, -5,-5,-5, 5,-5,-5, 5,-5,5ππREM template:wallππDATA 2, 4, 5,-5,0, 5,5,0, -5,5,0, -5,-5,0,  4, -5,-5,0, -5,5,0, 5,5,0, 5,-5,0πππREM objectsππDATA 36ππREM wallsππDATA 3, 5,0,0, 0,0,0,  3, 15,0,0, 0,0,0,  3, 25,0,0, 0,0,0πDATA 3, 35,0,0, 0,0,0,  3, 45,0,0, 0,0,0,  3, 55,0,0, 0,0,0,  3, 5,0,70, 0,0,0πDATA 3, 15,0,70, 0,0,0,  3, 25,0,70, 0,0,0,  3, 35,0,70, 0,0,0ππDATA 3, 45,0,70, 0,0,0,  3, 55,0,70, 0,0,0,  3, 0,0,5, 1.57,0,0πDATA 3, 0,0,15, 1.57,0,0,  3, 0,0,25, 1.57,0,0,  3, 0,0,35, 1.57,0,0πDATA 3, 0,0,45, 1.57,0,0,  3, 0,0,55, 1.57,0,0,  3, 0,0,65, 1.57,0,0πDATA 3, 60,0,5, 1.57,0,0ππDATA 3, 60,0,15, 1.57,0,0,  3, 60,0,25, 1.57,0,0,  3, 60,0,45, 1.57,0,0πDATA 3, 60,0,55, 1.57,0,0,  3, 60,0,65, 1.57,0,0,  3, 65,0,30, 0,0,0πDATA 3, 75,0,30, 0,0,0,  3, 65,0,40, 0,0,0,  3, 75,0,40, 0,0,0πDATA 3, 80,0,35, 1.57,0,0ππREM other objectsππDATA 1, 15,0,15, 0,0,0,  1, 45,0,15, 0,0,0πDATA 2, 25,0,35, 0,0,0,    1, 15,0,55, 0,0,0πDATA 1, 45,0,55, 0,0,0,  1, 25,15,35, 0,0,0ππππππππTyler Barnes                   STARFIELD WITH BACKGROUND MUSICFidoNet QUIK_BAS Echo          02-22-96 (20:58)       QB, QBasic, PDS        62   2239     MUSISTAR.BAS'Ok, here's a star field I wrote (The kind that has layered stars movingπ'sideways) and it has background music. I can't say it couldn'y be programmedπ'better, but it should give you an idea on how to do background music. By theπ'way, when you run it, it'll ask for a bunch of settings. I suggest 75 star, 3π'layers, layer speeds at 1, 1.5, and 2, Music on. You may have to adjust theseπ'setting according to taste, and the speed of your computer.π'Oh, also, make all the stars move left. It looks stupid if they move inπ'different directions.ππ'By D. Tyler Barnes '95π'Tested on a 486dx2 80mhzπON PLAY(1) GOSUB MuchMusicπCLSπINPUT "Number of stars:", StarNum%πINPUT "Number of layers:", LNum%πDIM StarX(StarNum%), StarY(StarNum%), Layer(LNum%)πFOR L = 1 TO LNum%πPRINT "Layer"; L; " speed:";πINPUT Layer(L)πPRINT "Layer"; L; " direction [L/R]";πDO: K$ = UCASE$(INKEY$): LOOP UNTIL K$ = "L" OR K$ = "R"πIF K$ = "L" THEN Layer(L) = -Layer(L)πPRINTπNEXT LπPLAY ONπPRINT "Music? [Y/N]";πWHILE A$ <> "Y" AND A$ <> "N": A$ = UCASE$(INKEY$): WENDπIF A$ = "Y" THEN MBuff$ =π"T150L2O3CGP16L16FEDL2>C<GP16L16FEDL2>C<GP16L16FEFL2D"πPLAY "MB X" + VARPTR$(MBuff$)πSCREEN 13πFOR I% = 1 TO StarNum%πStarX(I%) = (RND * 319) + 1πStarY(I%) = (RND * 199) + 1πNEXT I%πDOπCL = 1πFOR I% = 1 TO StarNum%πPSET (StarX(I%), StarY(I%)), 0πIF I% > (StarNum% / LNum%) * CL THEN CL = CL + 1πStarX(I%) = StarX(I%) + Layer(CL)πIF StarX(I%) < 1 THEN StarX(I%) = 319: StarY(I%) = RND * 199πIF StarX(I%) > 319 THEN StarX(I%) = 1: StarY(I%) = RND * 199πC% = (CL * 4) + 19πPSET (StarX(I%), StarY(I%)), C%πNEXT I%πLOOP UNTIL LEN(INKEY$)πENDπMuchMusic:πCount% = Count% + 1πSELECT CASE Count%πCASE 0: MBuff$ = "T150L2O3CGP16L16FEDL2>C<GP16L16FEDL2>C<GP16L16FEFL2D"πCASE 1: MBuff$ = "P16L16<GGGL2>CGP32L16FEDL2>C<GP16L16FEDL2>C<GP16L16A+"πCASE 2: MBuff$ = "AA+L1GL2G.L8<G.L16GL4A.L8A>FEDCL16CDEDP16L8"πCASE 3: MBuff$ = "<AL4BL8G.L16G"πCASE 4: MBuff$ = "L4A.L8A>FEDCGP8L4D.P8L8<G.L16GL4A.L8A>FEDCL16"πCASE 5: MBuff$ = "CDEDP16L8<A"πCASE 6: MBuff$ = "L4BP16L8>G.L16GL8>C.L16<A+L8G+.L16GL8F.L16D+L8D.L16CL1G"πCASE 7: MBuff$ = "L2G.P16L16GGGL8>CP8L16<CCCL2C.": Count% = -1πEND SELECTπPLAY "MB X" + VARPTR$(MBuff$)πRETURNπEric Carr                      SCALE SPRITE                   FidoNet QUIK_BAS Echo          03-18-96 (13:23)       QB, QBasic, PDS        45   1712     SCALSPRT.BAS'Ok..Here is a routine (I just made it so...) that scales a sprite on theπ'screen. It can scale to ANY size, and it only uses Integers, not floatingπ'point math, so it runs really smooth on my 486sx when it's compiled..Feel freeπ'to use or modify this for your own programs, but just give me a little creditπ'for it if it's used in a game or somthing..π'The sprite in here is a 64x64 block of colors..You would have to load in yourπ'own sprite from the Harddrive and make sure SP is DIMed the correct amount.π'The sprite data is stored in horizontal runs (X) from up to down..π'For example, a 4x4 sprite would be 16 #'s long -π'sprite>  0/\0π'         //\\     _π'         //\\     _   0/\0//\\//\\0||0       Except it would be in numbers,π'         0||0                                not characters.ππ'One last thing, this only scales sprite bigger than the original.  I haven'tπ'perfected scaling a sprite smaller yet.. Thats why it starts scaling at theπ'orignal size, not smaller.ππ DEFINT A-Z: SCREEN 13: DEF SEG = &HA000: DIM SP(4096)ππ'Load your sprite into SP. The size is 64x64 but you can change it.ππ FOR T = 1 TO 4096π C = C + 1: IF C > 64 THEN C = 1π SP(T) = Cπ NEXT Tπ 'End of sample sprite makingππ SX = 64: SY = 64 ' Size of original spriteππ FOR SF = 64 TO 192 '(192 IS 64*3 - scaling to 3x)π LX = SF: LY = SF   ' LX and LY are the new Sprite sizesπ GOSUB SCAL.SPRTπ NEXT: SLEEP: ENDππSCAL.SPRT:π CT = 1: ERY = 0π FOR Y = 1 TO LY: ER = 0π FOR x = 1 TO LX: POKE 320 * Y + x, SP(CT)π ER = ER + SX: IF ER > LX THEN ER = ER - LX: CT = CT + 1π NEXT xπ ERY = ERY + SYπ IF ERY > LY THEN ERY = ERY - LY: CT = CT + 1 ELSE CT = CT - (SX - 1)π NEXT Y: RETURNππPeder Brynolf                  3D MATRIX ROTATIONS            [e-mail]          03-22-96 (07:45)       QB, QBasic, PDS        164  3152     3DROT.BAS   'This one shows how to do some 3d matris rotations.ππCLSππPRINT "Typ 125 okompilerad för 1vbl"πPRINT "Typ 220 kompilerad för 1vbl"πPRINT : PRINT "På en 66a asså!"πPRINTππINPUT "Antal punkter:"; NOP%ππSCREEN 13πRANDOMIZE TIMERπππREM NOP% = 150ππON KEY(10) GOSUB QUITπKEY(10) ONππDIM OX%(NOP%), OY%(NOP%), PFX(NOP%), PTX(NOP%), PFY(NOP%), PTY(NOP%), PFZ(NOP%), PTZ(NOP%), XP(NOP%), YP(NOP%), ZP(NOP%), SX%(NOP%), SY%(NOP%), SZ%(NOP%), KX(3), KY(3), KZ(3), CX%(3), CY%(3), CZ%(3)ππRADC = 1.745328E-02ππFOR I% = 0 TO 63π   PALETTE I%, I% + I% * 256 + I% * 65536πNEXT I%ππFOR I% = 0 TO 3π   READ KX(I%), KY(I%), KZ(I%)πNEXT I%ππFOR I% = 0 TO NOP%π  π   S% = RND * 6π   IF S% = 0 THEN XP(I%) = RND: YP(I%) = RND: ZP(I%) = 0π   IF S% = 1 THEN XP(I%) = RND: YP(I%) = RND: ZP(I%) = 1π   IF S% = 2 THEN XP(I%) = RND: YP(I%) = 0: ZP(I%) = RNDπ   IF S% = 3 THEN XP(I%) = RND: YP(I%) = 1: ZP(I%) = RNDπ   IF S% = 4 THEN XP(I%) = 0: YP(I%) = RND: ZP(I%) = RNDπ   IF S% = 5 THEN XP(I%) = 1: YP(I%) = RND: ZP(I%) = RNDπ πNEXT I%πππDOππFOR I% = 0 TO 3π   CX%(I%) = KX(I%) + XPπ   CY%(I%) = KY(I%) + YPπ   CZ%(I%) = KZ(I%) + ZPπNEXT I%πREM *** ROTATE X/Y ***ππSV = SIN(RADC * ANXY)πCV = COS(RADC * ANXY)ππFOR I% = 0 TO 3π   TX% = SV * CX%(I%) + CV * CY%(I%)π   TY% = -SV * CY%(I%) + CV * CX%(I%)π   CX%(I%) = TX%π   CY%(I%) = TY%πNEXT I%ππREM *** ROTATE X/Z ***ππSV = SIN(RADC * ANXZ)πCV = COS(RADC * ANXZ)ππFOR I% = 0 TO 3π   TX% = SV * CX%(I%) + CV * CZ%(I%)π   TZ% = -SV * CZ%(I%) + CV * CX%(I%)π   CX%(I%) = TX%π   CZ%(I%) = TZ%πNEXT I%πππREM *** ROTATE Y/Z ***ππSV = SIN(RADC * ANYZ)πCV = COS(RADC * ANYZ)ππFOR I% = 0 TO 3π   TY% = SV * CY%(I%) + CV * CZ%(I%)π   TZ% = -SV * CZ%(I%) + CV * CY%(I%)π   CY%(I%) = TY%π   CZ%(I%) = TZ%πNEXT I%ππFOR I% = 1 TO 3π   CX%(I%) = CX%(I%) - CX%(0)π   CY%(I%) = CY%(I%) - CY%(0)π   CZ%(I%) = CZ%(I%) - CZ%(0)πNEXT I%ππCX0% = CX%(0)πCY0% = CY%(0)πCZ0% = CZ%(0)πCX1% = CX%(1)πCY1% = CY%(1)πCZ1% = CZ%(1)πCX2% = CX%(2)πCY2% = CY%(2)πCZ2% = CZ%(2)πCX3% = CX%(3)πCY3% = CY%(3)πCZ3% = CZ%(3)πππFOR I% = 0 TO NOP%π  π   XP = XP(I%)π   YP = YP(I%)π   ZP = ZP(I%)π  π   SX%(I%) = CX0% + CX1% * XP + CX2% * YP + CX3% * ZPπ   SY%(I%) = CY0% + CY1% * XP + CY2% * YP + CY3% * ZPπ   SZ%(I%) = CZ0% + CZ1% * XP + CZ2% * YP + CZ3% * ZPππ   IF SY%(I%) > 80 THEN SY%(I%) = 80ππNEXT I%ππFOR I% = 0 TO NOP%π   SK = 300 / (300 + SZ%(I%))π   SX%(I%) = SX%(I%) * SKπ   SY%(I%) = SY%(I%) * SKπNEXT I%ππFOR I% = 0 TO NOP%π  π   X% = SX%(I%) + 160π   Y% = SY%(I%) + 100π   PSET (OX%(I%), OY%(I%)), 0π   OX%(I%) = X%π   OY%(I%) = Y%π   PSET (X%, Y%), 32 - SZ%(I%) / 8ππNEXT I%ππREM WK:     IF INKEY$ = "" THEN GOTO WKππANXY = ANXY - .25πANXZ = ANXZ - .5πANYZ = ANYZ - 1ππXP = SIN(RADC * BANAN * 1.7315) * 40πYP = SIN(RADC * BANAN * 2.3125) * 40πZP = SIN(RADC * BANAN * 3.2357) * 200πBANAN = BANAN + .5ππREM *** Wait vbl ***ππWVBL: A% = INP(&H3DA)π      A% = A% MOD 16π      A% = A% / 16π      IF A% <> 1 THEN GOTO WVBLπLOOPππDATA    50,50,50, -50,50,50 ,50,-50,50, 50,50,-50ππQUIT:πSYSTEMππPeder Brynolf                  2D ROTATING TEXTURE MAPS       [e-mail]          03-22-96 (07:45)       QB, QBasic, PDS        151  2439     2DMAPS.BAS  'Here's a little program showing how to 2d-rotate texture maps.ππDECLARE SUB TEXTLINE (X1, X2, Y, TX1, TY1, TX2, TY2)πRANDOMIZE TIMERπZANM = 3.14159 / 180ππSCREEN 13πNOP = 4ππPRINT "01234567"πPRINT "HEJSAN!"πPRINT " FUNKAR"πPRINT "DETTA SÅ"πPRINT "BLIR JAG"πPRINT "  GLAD!"πPRINT " ALTER"πPRINT "  EGO"πDIM X(NOP), Y(NOP)πDIM TX(NOP), TY(NOP)ππDOπRESTORE POLYCOORDSπFOR I = 0 TO NOP - 1π   READ X(I), Y(I)π   X(I) = SIN(ZANM * ((I * 90) + an)) * 50 + 160π   Y(I) = COS(ZANM * ((I * 90) + an)) * 50 + 100πNEXT Iπan = an + 1ππOX = X(3)πOY = Y(3)πFOR I = 0 TO 3π   X = X(I)π   Y = Y(I)π   LINE (X, Y)-(OX, OY)π   OX = Xπ   OY = YπNEXT IππRESTORE TEXTCOORDSπFOR I = 0 TO NOP - 1π   READ TX(I), TY(I)πNEXT IππDIM XP(199), TXP(199), TYP(199)ππFOR Y = 0 TO 199π   XP(Y) = -1πNEXT YππOX = X(NOP - 1)πOY = Y(NOP - 1)πOTX = TX(NOP - 1)πOTY = TY(NOP - 1)ππFOR I = 0 TO NOP - 1π   X = X(I)π   Y = Y(I)π   TX = TX(I)π   TY = TY(I)π  π   XF = Xπ   YF = Yπ   XT = OXπ   YT = OYπ  π   TXF = TXπ   TYF = TYπ   TXT = OTXπ   TYT = OTYππ   IF YF = YT THEN GOTO SKIPIT2ππ   IF YF > YT THEN SWAP YF, YT: SWAP XF, XT: SWAP TYF, TYT: SWAP TXF, TXTππ   XSK = (XT - XF) / (YT - YF)π   XC = XFπ  π   TXSK = (TXT - TXF) / (YT - YF)π   TXC = TXFπ   TYSK = (TYT - TYF) / (YT - YF)π   TYC = TYFπ  π   FOR YC = YF TO YT - 1π     π      IF XP(YC) = -1 THENπ         XP(YC) = XCπ         TXP(YC) = TXCπ         TYP(YC) = TYCπ      ELSEπ         OXC = XCπ         OTXC = TXCπ         OTYC = TYCπ         πREM         LINE (XP(YC), YC)-(XC, YC), 4π         TEXTLINE XP(YC), XC, YC, TXP(YC), TYP(YC), TXC, TYCπ         XP(YC) = -1π         XC = OXCπ         TXC = OTXCπ         TYC = OTYCπ     π      END IFππ      XC = XC + XSKπ     π      TXC = TXC + TXSKπ      TYC = TYC + TYSKππ   NEXT YCπ πSKIPIT2:ππ   OTX = TXπ   OTY = TYπ   OX = Xπ   OY = YπNEXT IπLOOP UNTIL INKEY$ = " "πSYSTEMπPOLYCOORDS:πDATA 113,154πDATA 288,181πDATA 245,124πDATA 96,19ππTEXTCOORDS:πDATA 0,0πDATA 64,0πDATA 64,64πDATA 0,64ππSUB TEXTLINE (X1, X2, Y, TX1, TY1, TX2, TY2)ππIF X1 = X2 GOTO SKIPITππIF X1 > X2 THEN SWAP X1, X2: SWAP TX1, TX2: SWAP TY1, TY2ππXSK = (TX2 - TX1) / (X2 - X1)πXC = TX1πYSK = (TY2 - TY1) / (X2 - X1)πYC = TY1ππFOR X = X1 TO X2π   C = POINT(XC, YC)π   PSET (X, Y), Cπ   XC = XC + XSKπ   YC = YC + YSKπNEXT XππSKIPIT:πEND SUBπAaron Scott Zabudsky           COLOR BARS THAT COLOR CYCLE    [e-mail]        09-05-94 (21:40)       QB, QBasic, PDS        25   418      COLRBARS.BASDIM c(255, 3)πSCREEN 13πc = 1πFOR y = 0 TO 20πFOR z = 1 TO 256πPSET (z, y), cπc = (c + 1) MOD 256πIF c = 0 THEN c = 1πNEXT zπNEXT yπFOR z = 1 TO 255πOUT &H3C7, zπc(z, 1) = INP(&H3C9)πc(z, 2) = INP(&H3C9)πc(z, 3) = INP(&H3C9)πNEXT zπFOR o = 1 TO 255πFOR z = 1 TO 255πOUT &H3C8, zπOUT &H3C9, c((z + o) MOD 256, 1)πOUT &H3C9, c((z + o) MOD 256, 2)πOUT &H3C9, c((z + o) MOD 256, 3)πNEXT zπNEXT oππAaron Scott Zabudsky           COMPUTERIZED SPIROGRAPH        [e-mail]        05-19-93 (12:36)       QB, QBasic, PDS        14   350      SPIRO.BAS   SCREEN 12πCLSπox = 300: oy = 300: r = 30πFOR n = 2 TO 50 STEP .5ππpi = 3.141592653589793#πFOR x = 0 * 100 TO 2 * 100 STEP nπREM LINE (ox, oy)-(ox + 100 * COS(x), oy + 100 * SIN(x))πLINE (ox + 100 * COS(x * pi / 100), oy + 100 * SIN(x * pi / 100))-(ox + 100 * COS(x * pi / 100 + n), oy + 100 * SIN(x * pi / 100 + n))ππNEXT xπCLSπNEXT nππEarl L. Montgomery             REVERSING SCREEN IMAGE         FidoNet QUIK_BAS Echo          02-18-96 (12:41)       QB, QBasic, PDS        29   742      REVERSE.BAS  'Noticed you were asking about turning the screen upside down. Hereπ 'is a routine that does a mirror image. I had written a program thatπ 'will reverse the screen horizontally and vertically. Will have toπ 'look for the source code.ππDEFINT A-ZπSCREEN 9πDIM bottom(1500)πCOLOR 14πLOCATE 12, 30: PRINT "Earl L. Montgomery"πCIRCLE (100, 100), 10πLINE (100, 108)-(100, 114)πLINE (84, 114)-(115, 114)πLINE (84, 114)-(84, 134)πLINE (115, 114)-(115, 134)πLINE (100, 114)-(100, 144)πLINE (100, 144)-(90, 174)πLINE (100, 144)-(110, 174)πCOLOR 4πLINE (0, 0)-(639, 50), , BFπv1 = -0: v2 = 350πFOR x = 0 TO 349πv1 = v1 + 1πv2 = v2 - 1πGET (0, v1)-(639, v1), bottomπPUT (0, v2), bottom, PSETπSOUND 32000, .5πNEXTπSLEEP 100πEarl L. Montgomery             BACK SWITCHING                 FidoNet QUIK_BAS Echo          03-21-96 (21:23)       QB, PDS                58   1394     BANKSWIT.BAS 'This program demonstrates how to use bank switching so that youπ 'can poke the entire 720X540X256 screen rather than use the slowπ 'ROM Bios interrupt SETPIXEL. This code will work with Videoπ '7 graphic chips. If you do not have a video7 graphic chip butπ 'would like to run this demo. Please give me the name of yourπ 'graphic card/chip and I should be able to furnish you with theπ 'correct code so it will run on your system.ππ '$INCLUDE: 'qb.bi'π DIM inreg AS RegTypeπ DIM outreg AS RegTypeπ DEFLNG A-Zπ inreg.ax = &H6F05π 'inreg.bx = &H66: flag = 66:   '640x400x256π 'inreg.bx = &H67: flag = 67:   '640x480x256π inreg.bx = &H68: flag = 68:    '720x540x256π 'inreg.bx = &H69:flag = 69:    '800x600x256π CALL interrupt(&H10, inreg, outreg)π DEF SEG = &HA000π FOR x = 0 TO 65535π POKE x, 4π NEXTπbank1:π OUT &H3C4, &HE8π OUT &H3C5, &H10π FOR x = 0 TO 65535π POKE x, 184π NEXTπbank2:π OUT &H3C4, &HE8π OUT &H3C5, &H20π FOR x = 0 TO 65535π POKE x, 4π NEXTπbank3:π OUT &H3C4, &HE8π OUT &H3C5, &H30π FOR x = 0 TO 65535π POKE x, 3π NEXTπbank4:π OUT &H3C4, &HE8π OUT &H3C5, &H40π FOR x = 0 TO 65535π POKE x, 143π NEXTπ IF flag = 66 OR flag = 67 THEN GOTO bank5notneededπbank5:π OUT &H3C4, &HE8π OUT &H3C5, &H50π FOR x = 0 TO 65535π POKE x, 3π NEXTπbank5notneeded:πSLEEP (100)πinreg.ax = &H3πCALL interrupt(&H10, inreg, outreg)πCLS : ENDπJeff Lawson                    TGA VIEWER (320X200)           x2ftp.oulu.fi                  02-10-94 (11:50)       QB, QBasic, PDS        30   639      TGAVIEW.BAS DEFINT A-ZππCONST FontHeight = 23πCONST ScreenWidth = 320 / 4ππSCREEN 13ππ'display the bitmapπOPEN "BIGHEART.TGA" FOR BINARY AS #1πSEEK #1, 19πFOR Attr = 0 TO 255π    Value$ = SPACE$(3)π    GET #1, , Value$π    Red& = ASC(MID$(Value$, 3))π    Green& = ASC(MID$(Value$, 2))π    Blue& = ASC(MID$(Value$, 1))π    OUT &H3C8, Attrπ    OUT &H3C9, Red&π    OUT &H3C9, Green&π    OUT &H3C9, Blue&π    'PALETTE Attr, 65535 * Blue& + 256 * Green& + Red&πNEXT AttrπSEEK #1, 19 + 768: A$ = " "πFOR Row = 0 TO 199π    FOR Col = 0 TO 319π        GET #1, , A$π        PSET (Col, Row), ASC(A$)π    NEXT ColπNEXT RowπCLOSE #1πDave Shea                      ANIMATION OF RUNNING MAN       FidoNet QUIK_BAS Echo          03-24-96 (00:00)       QB, QBasic, PDS        37   2364     RUNMAN.BAS  DEFINT A-Z:DIM SHARED K,S,B&,Z&:V1 'Created by PostIt! 7.2πSUB V1:OPEN "O",1,"MAN.ZIP",4^6:Z&=1493:?STRING$(50,177);πU"%up()%9%%%#-%/YnLE:;0M\j'.%%v8%%%,%%%%rf%sSgf4xfev):re5c#X*8'<uπU"mVV&*O,9PIKC2g3B6V[YRa]mVbsFy'4<ODK>NE,zK5g#pA##bA7W2hhn$1$N6[-πU"G>Gs7JiPxETiJ:(-0bPSSm:2</dVpW1++h*hQ<'*9;z19Y3[Y2Fcj4^hw6g>eJ%πU"eSb7TiCK(YVtZNg^UKIrDV0*lG1*7H(JV6QFA%[Z;P5QM8=Dg$kmaUeJsNxou:^πU"vo>tH.HAE&LkMTfXoobL?c-$h3Tklnb8Y[qs=LX\VvKmC]77i$V_Y,?1''NXO]+πU"<iVP3[B\AMOD3tsF2SX8NHo8b&uKr2JiZ85lKEovjKfj->>I5n;Bb_+mBYb9/s(πU"RCHN-l+A/AV]#dkArq)CT+f&j%94HUpg#W(oWh<PAfA9<xL%15TE-H[y_#$<CV#πU"=IEfgGTK&cOPsEcDr>o9o$;v._\lmDn(h4jp>%S>%r&cP.gQy0J$Cg[Z+B3/p?aπU"3.Bv\u5V'w+0%h6y6\Pp$kyZ;fk_<7S&%CJg#ovD]8vL[<oGhni:TfljTrYpy9.πU"gqu4<;<pjJRq:pnwTk^&Nt1(Gb]:B1ZqRC#29FK_6Q*i\gH3Y7?BPqoii5gnXwHπU":aRFWms)eZ4;agMjDaype?2Gt>V3Y'YJn-Lt4\N<G4mvSV?M(/m1Y4E1zDL/-c9πU"[PIguDyp:(FaXgDJJ87/%<+/HWzFAPxRZno7JGL#z4K57go#Qo#'S'>5Q4#MEH-πU"mG[v(Q0W3\+=DoVXtsDf>zP'&meIiF6&j,Wm.IWE/8iJ)\]LnnZk%PiaGE/>7]xπU"L=?v*g]5rFWtFJjXK*jro?PaqcWIqJwWPwhrowacxZNs0rTwRtnM:c3(;=*8&%uπU"p()%9%%%I-%^SmxER905]?'[%%,s%%%,%%%%rf%sSfsXrfT,,ASU9d+u<=99SkOπU"RRN%w>:b+_NLhins+B\d%Eq(Y9$a_#Y(k#DrisLX]blobe&'-SF[mBrO#sZRn>=πU"nLuXvsTQh<LmLdIKNitLXo>Hwa>fsP>N6jSRdJLYE*QF_2mfX7N37tDf<Y%bhypπU"MkSdjl,.6DuH&93pHTMtK-((Z/X#iGk#8;gTn?60HNibl;Vr-FRDvmq^iPXM:*>πU"i5,N.cUCp3+'.tckAx)v+UwXg8dFo2+uFVJZeQfc[b9DIccPo\8uH*8c*jgqwZIπU"sj$eYCk>Zr4sEhvzAhp*v0U<()l[F/?J]1;%L7XjNWEi:ta[$JkkvgS:E4NqCF^πU"W?3p4dv>ruFtt#]'vBs6OY**WZ[w[7?5TVXgit\s+BP1^t^X8fp0%,HgF[rarp.πU"GZ-h8wsHtFkx9CSJ5dl0zG+tvgypDrXo1aLN\hnHNRbk;Tb>>u?.ni=Cb84HHc_πU"XVMa9(Ao/qq8.v:K:_ofSQ[_;ulEP?tT/B-.vZBSLi<Htj1SR/acZ3cN_$obFrcπU"(f$T[?A?xL<MNjpMgbwrjc#<UE=i$+S,(tK<si<*S%MO0vh8rMZtib:vfvyNsYJπU"7w=isFyx%Z'%%j%YDuXqahPKvN?,PLs*&en+&/nvclpoQ&MYH3s7:/UtN+Hi:8wπU"l:TzL-Ys/8FP#tTt:CLZ[boq%s=9=3hv&RvlffD1l+=u:UinjNb58Lmup)smnvdπU"vb:tNattN(^v),L%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%dπU"%%nq%(up&%'9%9%%%%-I%/YLsE:;M(\j'%(%v8%%%,%%%%%%%%%&%E%%%%%%%%%πU"r%fsSg%fxup%&'9%%9%%%I-%^SmxER905]?'[%%,s%%%,%%%%%%%%%%%%E%%%'9πU"'%%%rfsS%fsru%p*+%%%%%'#%'%9%%%%z%*%%%%%πEND SUBπCLOSE:IF S=134AND B&=Z&THEN?" :) Ok!"ELSE?" :( Bad!πSUB U(A$):FOR A=1TO LEN(A$):C=ASC(MID$(A$,A))-37:IF C<0THEN C=91+C*32πIF K<4THEN K=C+243ELSE?#1,CHR$(C+(K MOD 3)*86);:K=K\3:B&=B&+1πS=(S+C)AND 255:NEXT:LOCATE,1:?STRING$(B&*50\Z&,219);:END SUBπUnknown Author(s)              COLORFUL WORMHOLE              [e-mail]   12-14-95 (00:00)       QB, PDS                136  8958     TUNNEL.BAS  '>>> Page 1 of TUNNEL.ZIP begins here. TYPE:BINAA TLEN:6362πDEFINT A-Z:DIM SHARED K,S,B&,Z&:V1 'Created by PostIt! 7.1πSUB V1:OPEN "O",1,"TUNNEL.ZIP",4^6:Z&=6362:?STRING$(50,177);πU"%up()%9%%%R-%DR\5E1Q>XQS'%%%y/%%%/%%%%yz%ssjq%SgfxNf%<>\jU5w5]=πU"N]*n4X2HR).8LG<d[%rwY'(:uByZtvx2&F[5mrLCtWU4W\HVmJ:F-?aq:?+G9a,πU"viyyX2)-Jn$*-0.F]z#^RD#qPmGEHiRO+7*s-Rpn,BkPU1iu_uN7pn1kFtaf]/DπU"rF&-+8qowC6_J=0R0)-i/fOVUS[zZmqR.b[J%%NcoaWkBSI4E_JKEoZZ&W-#hj+πU"qks;-h.2Nb<?xB.0SaII-pj4bpicWtYqX8<K/?5<$rO9lW?.;V1BNaTH6-jit:%πU"k^j>pAzI;*Y$ifE4:#I>a.1(7bX'(qg3+;'%t;&(0J$y<?k#=q;qm;*#)#02KS^πU";.-U'-H9#$Qid&QO(3fIDlEO'[#h;3(C-'$R%9Am%vmOGMwX>jVODB$q#'4gW)1πU"r(+.J;80a^Q?'4:wR9z]:77e6%9Ev4D48y;l0H^MU>D-/rt-[]%SZ\s&3?/>MXdπU"Sb?_a0#Is^]8lFB71M8(9Pk3Z3k\NEhaW_1,gf+l:B2=W89RmYFX4\W]mgV*\AhπU"RkLRA37wU3rW]k6/gQPKMr1/[hEa-?*[2()<[sa(:*.PvGsUq)T)#mPz<QgAVe4πU":S&H2hKH[N.Ki=&;[t#J42_aRangUa2(GNC2ExVF?*pM:\+1*(t&LcOFPt7/GieπU".eqLd&Tp1G,NO^)B/.\(\('F1y3Iy8?wVW1T%r,e357%?W%M3xVL]V44djAXlk]πU"v-V\nGXkprozI,cC*Y?jfxx-9M4adbe6u=&Kod5%U8ibNv5g,J6nH8WxL]Jq8N7πU"nb,(K'>f/h,u'x)4b<</XS:4HTJ*+,LuGF$U\KY\hpAf<Qg=uxAnodAV3q;k+uUπU"HN]Vs+1BQ4flUixXP-3#EFI7H<$]sX,5xYllVK4iQ.QSZO5l[KCsdhqymYNp2-3πU"r1y8+]g+p2c3kbX't0up%()9%%%%-%3NW]DN;fB%%W6%%&+?%%%-%%%%uqty%SvπU"qgNfgJCdyjm#>zh,r&1#X=$J4_AZZ=J7HmKQA^[UGH#sUIlFY]fU'-F.5<ARbl5πU"QE[)W\QF\%fCWsQ(%Sw-dkuU)mheA<LpJE9*uI*O'EyO0\r)n%1oh;kBp&Nk\ghπU"jEemb66xUUtYNdjzS.zvyb=VoHY.-?_DW-jB/$3nVCCpL.l^I6AA[5Wo_.oVw)0πU"/[UF<A&;7eNi]0)A'*K%+)OV6O$Og<Ol9P:9Moa#i(#/OV/AKY12K[95,Ua2U4uπU"^(_3E1(YOj097/*9Y)O%#t&#P^RO4Qa*e+W#)3&68P09UdU+[L8M]a,8g+E%EKPπU"G/F6))'.&]PZ99x9k8/0Y(SE&4P^\Ph9G0Y=?#7]0+1%UPVS/AYG0a4W(0g+u&BπU"p(XP(lPqE^4'%u^7w+c7%\i#3Y8o29Q+5-951e*9W'W+&]%D%Sn%$Pjp9&9-092πU"e=5?q=&/7U*9YFOK.E;W($[PN91ICh<0I5>)D1O\$\QCf0,qreV'i]u0\k[MaFxπU"Yp/%)-&_^EB/3F218?DQl,'[0yfwI+Uh&'IoEoauI(9^[o0a(&]'<%&syu(8?=]πU"%*Im/.o+e&A>&,PM1rQEL(]*o[1]3uux$xg9,uvooF\'4NW^i6GzRVxuQIu)S)AπU".=RA7puGK]W;0R]C%2xRLfn]D]HhCrlf/MZ*o(O]ntSKkG7.B[Gg)Z^>H>M9<t;πU"izrvFnrV8Z%>I.r.WsBp;/3qPgm.V[\:qbTiKxFroNlbO[]$J#+yxb;A$LtI1EQπU"V#-CK'K8THbmY,:PG+]pV;\j%LEH0Ro$gMEBJ&%t_5G9&+&X&mb*a*7S=oo&1[LπU"C?ghV60YIYB6Kr;?+Z\>[L:$i.GQjm)XY1]QNk9)gi1\QR)H=Iqh.8mjiH+)HK=πU"d8afY(YQX.BGG]j8/P:^+)$7a>^Yr).<5;H<1_YGAQ<7+^q?.:/t)f6W5WYADQfπU"5+^j?Z:%Z)TJnG^:.F)(EG4J:D)R\55Y$Y.6eaIQj)_j/4:%r)\8ou):dF.We?=πU"#:H7r5XY$a-Wqi:;Q07r5\Y$a.WsiKh-MXEYl)Fj55ZYUsQxdcYV)hOHqDQ0XEGπU"dB:,-M,bYd7TUring-MVY;-Qv)Kp6Kg9Y%:lg.MnY&2)hq8^8uFB:D6K,QYt-0wπU"\Qtg6KiY%X)47VKeYB^)nLq9H)x$$:n7u4>:f-Nwa/\9YE:HC)^6KbdY5:*P/b]πU"&O,i%>Q'D%1i-^+)1O$%^-w3Z]MD(k1%Wz3-JIFAF_=h>=g>T\Pz#QFL9zN%4,MπU"S9ol-$2/y3y*YQSExi_=s>OGN#2c<Y0Trr>Ef-$oJyL);ydVZeVu3OO_wf9ZN\#πU"9wC8(3e+_BPP,ut8tmFheBxc,HnmwVnBORP#Axs^mNeGSsrKIV4bm[>1j<+NK6\πU"?0>JT[osnsUnja;bdw-g;ZdBdd$aBC*Umn.-4&DprlAkMi#2m2F*<eP[HTol8p*πU"It2ifeBcW#4tqZvgqc4cP<Np&6mO\LCF^/?x?pauT<umGFsU2eYO^jcZ(,s..VRπU"J0i-z$I#-RW5%B:UZE5\qAA5OJwIzcer_qso^.6U#PL)o\vSV.h:%9PuEM'a]MSπU"c.mpsfsM(9&=)9fYhp4%pAoH*(('dTVI$dF1%$dB=MW:3v-*VK=^:'Ik$mM?&ZHπU"P<06)T'FK<DMbST'vq)%=:qg[nTg:7xJ6A^/MyKpPoY*)a-.*;^cm?Ovila]WM9πU"e4Sb\fB:\pImrM10&s\;*S.Rb\4h:lJ$6buI]P(3wJx,)=EhPKjtJ9/&^,[[m+eπU"fxb>bJ)B,QMXJ&qxH_Ubq8WBa(6L(]qXH7_$%52Q]'c3cajDU_Woju-H7pGiT9jπU"n)F:Kk:8ma,[\pxesBYt,eGB/2c9D+L:E]9:BjdsD>,$Yaab^gU1jhEJG^eED=sπU"K9C&f_pQ4\wlE0/yf<[HfhAsLh4MKjq\;Y-lk+jt8PVh_Sdhooj[-rO^FF32RiMπU"(Q4M;oDG9cWY[,]'/Ke;y2;0mn=XU'h\nH[A#6(<VYo#)QqKF;ZNjV:3x_BfCzhπU"lEQ0t.k+%-jAi[O;,/SEwrPA&PsLUL.[QilJ]*vN+K:vwoHweV,]pc^SI7(JAL7πU"NBg3cVizFyxhZ=ls%[qt39k$wIx48AvOrPbqeJf84C9H9GI(0(J(Tr<NQt^[JsGπU"1gj>-b1S6[LY01#Y82shGM*DUtydh:.av/dYv.U7Zf\5u4=W:[HjiI)a^.iasYkπU"WqgM-Zr=C;V40jgwDE?QuoT=Qp=Xw9Zm*&J_K$jJ_[/P]//>/_p]X'>h;OwoDU3πU"1L*zi2BSTfP^XX]P>4=%&x%X\.6eAkkU=O,HX,UE5S&'&C.;ONsk*9G,DF^*QnRπU"Rjv31m+KB\+g\g78^lWcbn%/.TX2^/E9b8'Z>/-q8e*VAX;aG=O9-BOge7p8K#lπU"rvxB(NC2ud1IEt*u8XY9jDCgJoROK()GN2PfV3%]/4?gupIWE'mdGd/:QQ><7$2πU"<0qOHavc>f/Z#XR+]RHI'7L$WgS+H/r[UFgTT'N,1k*G].LbFf>xVpZ&3I_AZD2πU"=cp7be[-/wCO5Y9MD*QfSwW8o6FgjtE>095YpfYF%(NI(lUP9T%<fF28<+:cEv(πU"r72?:8/AUmX[(4170Z9g;.H.,qE8qekRIw17mw_IuCn/QL+>c$C]/c$6<UbSSXcπU"OHij*vK9DE#:;NY%]XbhJ/-g)(#duG,_dU^Gb<mz9BVt$\uEk:v4oh-JfbhZx6=πU"IdbsS<giO-[vq4iN;k>XfK9,3JFy'0BiRt&o-nc.5#ToW\HlA\_583YZV<kBp:CπU"Pp6YIjQb7d_Dp^WGFQe&0CR>z+4lD,ht?D$OF]\N[#BU-_g/9V#[jXqK]['IBRVπU"u+Y1LG]YfGqIVJ0*Ic7t9e_('/4S>9;)*W9:i;<i7bbkNKd]8p.:B:dGw_1C;$4πU"CLNCN5+))QJsm'YE:hwd-e?FEckX+rdkliHUSQM,jH)2+zLNSQsUZ==FbL28RB$πU"^l,UM?eA:ujtYDik73\v#)1+BmU_M^4#NF7U*48=KTLU=r,ElJsNlp/cf(05$-lπU"<z^a&[C)KR0Z7n^BYVHhGy^S)sokl^-r\;_jNSbl$Q3F_d1fmk$sJP<#3cnA=/+πU"0Xb,biSBPLJ-%J^>$/U[LC[TfGnb7fNQ=UMut-b%evj4^8t(Z^XnM'=<5DGJVePπU"_]9j&DzT/wjCht-X%FyTEdN:Hm0N//Cua&D^([^;Ck:]-&e>9:ajmh%GfYpT#0bπU".;VoZ=.&9i7cEJk_dT,XO?[VH#.Xe).Kqe;?Q2lCy7aC9b_6LOgljeY2m9D\B<dπU"xEJmb:iSBIdoSVVLD;2,5g'kFJNwAFyu>(v_._b'2D=tD-T3-buXN50QgCspIn%πU"]#aA#+b'Wu-dgTP_3gdC2)3N7(*FoF3^ETdy)Mox,dKZ>vRr^-dRk?N;XQc^^j/πU"&Pm6bl>D;Ea(K0Z-N6RyeujrYmD/N7m(vSSUu(jEr1&mag_LbX>iK$9[x'S<uOeπU"eY*^S1\Ex'j/SGOeB\GD29(>6^n,,:>7,DBHlB__y?jr.-G&(RJ^aEjz96u'H?rπU"KqI%,FF4HA\h.Pl/:Zj*fLFP3#pFBaVgv,Qv&+A^tHgi4Tm<dHmYZEP(re-S%kQπU"4h47b-[8SP4WwvDY\IhWDim#cZfCGJ,Q8NbFsOs%h4]4>5W/9i:?cwfu<dbiopyπU"=sMmrF'A]/V$ms'hpU5r_N#?v7#wr3W';9,p#Bj:m,/Jg_q\BxVIMDQ;RB6'9XQπU"0tcvs5X^s[d?/]JeM/>ODkoZVs_7\MX8S#p]YmMtZ+7OBXLdr^u-#)tO._K/ca'πU"uQ]YOXQWwR:bC89*v+;<Nba&h2.d&3yKXwnTRs'3kCT,ZPY'e(NUbLHB-bht[3ZπU"1)d1kHQGWleJP8NsJ/iJa.rI:9ohyU(ciwK-ElMP4:f\Du;Yd%fx>Y\dpx28(7CπU"M8gd8E2NxA/4RsXdkQh/xla$Nl4<k?Q8;IGx%\2Bf-BiGb+282QLWm5DEZ>(i.OπU"YR6'uCIY#Wr;1PhG[cev/04O1ZMe'H<;XS,9*za6UqdaHnr;CwuRQYVb?WQXFQlπU"Bb3F$-b8-TOV8JTgAu,;C?u,TtH%w)/_2Y5)V]0DE97jCCwg&N1(Y7u%eRyd.8wπU"FvNva\_Uh2E]mhF:A.xj1AWL*=8+/N]V>U^xsk[^x86b[xxH-Vh1SZgl^_Y0d2]πU"[LA.S*Eg6cfCi=]ucSwjXL)J+%0N3kMVg<-k8:^8u#>/tuT=Pbgg5pH+oTZW4(wπU"DS#TL=:VYb6n#JL\j6x6>28;K<N>x;K).XXKZau'W#rTul45ZvaAw<JX*RjIHfLπU"$t$^2Capmm4,uALw\ZKPq8U5XSvmL$(HU]m9PHMf_nepTcO+_KdY\8fY8gTs+uWπU"G7.9]K<_xTNN>a5Z=LuEfBeNP.f$tkc_hzb88[8Sn8?Dp(m>U2%mtXB\_qqHW)MπU"Zf^l8bLaFb\%<VFK?Vuk5e>d#ARXq\^*h'KvD=r%wFAHBPngR.6l<EYQ<-C(XRbπU"fpX&_eFV&hfn3fY%D84TrL^.+XVEdi:CZeP2cb.G33p-i&k5HBc#W1SI5m%NI-(πU"O$$\lv[6bSLYd[Jx_WM?J7pWE/DM\#ek\a:ILv(Q.<YGmBN]x-^3a\WGM2'TWKCπU"6\]Ea<6\2Z7KihN=cIF-aYrbO7&62^xOCMQIy^g=r'r_+21L3EW)H*sg6F3sz0FπU"(xSAZMz:yiq9wO3q$r7+B/&^+/zOj#&oULT%\d0^:AdRzrD&3UpP8+Wf.Q1dtwmπU"M2EUdsi$%Y9v_/&zT?YGERJUyDtc4Kz,#1w6jQerEze2f%b#'mT,l^%#Nl1Jy3%πU"k\O1ip&7DmP-P22ldzEQJYxz2z)-x'.7rtoDeR2<oq;g&cbTQB2JywN.zE(Ch4BπU"i&m.kp#AZs6G4.Xk)wRnR8#QEPr'C3;jJn\NKZiRv,mGIXu63JNdq$rbtyC337JπU"P<hVwC&spX/ffstMTbCq9?yV$L:2X^-\iMUu)6S2(]ZYAl&H>(rO*L^WH=_s]PdπU"fU5_?7KLFyOR&<'iCYzcbzdEI4ZED](D]vJQq4hQe?^kgL+iU7b%P[JI92Uz&ErπU"2rtRZkS:mq'6D1$;]gj4dL<f#NyLh_=e1eb9<Fr1#&c2aaLSZ;_6#::f9-Bk?;fπU"_JzKmXAo-5Cib6n=z.56/'iS)0rPaPpeH$I?M8yk#O&'M7CQH%KR1,[ERX,OMD=πU"6W*z(CsTxJ/W/PR5=VT%*j0,Y,HkRW&8%j;3Td2tV%;jk)E,5v;2')*laLUeD+BπU"NZSNSQ\Xh8se3Y?3<T7Y2d>>EPa/g4ctQ4U;2R?CCDoc,L2w_zyZG9S+/$r:s*3πU"l__;e3o+:c^PTN1S9#b17Y[NR3&z+;msZNIQ*%)%g4R^ms#R_ZaU<\VJU3Vv(CEπU"w8fet9]_+%:J\uD,4E-=>qS*dk;-)h1ls;LKr2EJe:)4v:^9KF3yFXL;sPpuTHeπU"HMkEk/Xt28T>mo+&Ip*$6#%m9Gf(AO%6CoiEC5EAKj;lO.CnnMef&_5P+=KcYg'πU"I0T0SIFR\V3LTjn-e_,6]&N'up%()9%%%%-%3MW]Dl:)T:&w&%%%4+%%%-%%%%uπU"qty%Sqng9fyHp]TuAxH7_l2<EgIh/TG\<eF5se%U)6#,jO/JD<,QRdFWp)tP.K-πU"d9a(6&ScMzCIW<zow*WmMu-S-lUQ4ws.V?QSE>T4'tKNwtslY*omhkk4crMcuX5πU"pv?kkv.YO#2+_;YE%6(_Z8h>[+Q#9%s'2jY55hRIx)_af:<QA_%%f,*(Gn30?4WπU"uiuK1GC=3sf1n:o%*huY[BYzqSTBX6SLrb&:-+wqXs7%Ul.b;CIxkbit-WXDOVFπU"ymJ&0%sO3;S*<dB%n/^kMg7O&$1;aZNbI9'x?Pl3S#&5SmkgPq1i%>DU=)ZL3slπU"HDspEAOwTIF9eRPsTCj(p/+%5cK$)\^e%O;b&yp.dXP1umsVM8IUc#hYH%uwY]RπU"iMJRe2%*veS>T8Gqg*_L.>Y9<OY?^6bsRVL=#RwqOo8ei#g$45KaOviF]'nYW\7πU"VB)W,BMV,9klEDbv9:T>qF$vZOO]3-Bq.V'^gr9Lq:VVreeei%60_Ece4<O'9ceπU"I(M5,Lx0+kk,SV\Etv8Qf6Rn+7w+.:-<s4%up()%9%%%R-%JW/]DZM/Mmk&.%%]πU"/%%%-%%%%uq%tySf7xrfz1r>Qej56jq4D1fYe/8qWC97oQbn&L\I&;);Uz%JUQoπU"PfDGFV&%0)bgCZ]+RHgX>0We*k0Hiv/3R9'W)RA6[ud>MhRV_j\8SJ9#/65521$πU"kmn,#sy?gaet9kA8rt'XmQX)an#FJbTAIa2\>OwjpFXAce26*#Jn/\xK#Z$/pMtπU"QUW#FfTc9J?$>?6L6cY4lPh7J'g$DkCY*M*7wPmio.%s?ew[rg?ukQ-'\hto3\rπU"Laq<9t7Z9Uj>>a&2o<YCXq=)Rn?6qSgKJV7vGi;Xn-D0.R&HfY?/%W]:4PC,rnYπU"rPZCGg-MP7:#1EgA-iDOf$bf#=s7+/ZFz5,<p0bgU.t<y,ZS?lL<Qb;FR_9fjeYπU"kw,p8WUR7.]?orj%e;fvP(T9[kRh5:U;qcQoOptzo'UIaJ:06g_BdK]73uUH.,4πU"l'tzbWIHL<Ghds-_xEBpC>BBhX)PszCp,,*MIB,d1dySZDScy'c/rl\3sQ8Rj#%πU"dLk)GH,+4-4#pkDoZqUpoZs.R'R'q&up%&'9%%9%%%R-%DR\5E1Q>XQS'%%%y/%πU"%%/%%%%%%%%%&%%E%%%%%%%%%yzss%jqSg%fxup%&'9%%9%%%R-%NWS]D;f)B%WπU"6.%%+?%%%-%%%%%%%%%%%%E%%%%'(%%%uqty%Svqg%up&'%9%9%%%%-%3MW]Dl:πU")T:&w&%%%4+%%%-%%%%%%%%%%%E%.%%)9%%%uq%tySq%ngup%&'9%%9%%%R-%JWπU"/]DZM/Mmk&.%%]/%%%-%%%%%%%%%&%%E%%%%M;%%%uqty%Sfxr%up*+%%%%%%)%πU")%'S%%%'c<%%%%%πEND SUBπCLOSE:IF S=37AND B&=Z&THEN?" :) Ok!"ELSE?" :( Bad!πSUB U(A$):FOR A=1TO LEN(A$):C=ASC(MID$(A$,A))-37:IF C<0THEN C=91+C*32πIF K<4THEN K=C+243ELSE?#1,CHR$(C+(K MOD 3)*86);:K=K\3:B&=B&+1πS=(S+C)AND 255:NEXT:LOCATE,1:?STRING$(B&*50\Z&,219);:END SUBπ'>>> Page 1 of TUNNEL.ZIP ends here. Last page. TCHK:37πEinar Tveit                    GRAPHICS DRAWING PROGRAM       comp.lang.basic.misc           04-12-96 (23:28)       QB, QBasic, PDS        694  13266    DRAW.BAS    DECLARE SUB Refresh (file$, colors%)πREM The intro was made with this program!!!πREM Hi, this program was made by Espen Tveit (me) to make it easyπREM programming graphic in qbasic, when you have printed your filenameπREM push enter and start drawing. If you have any comments send them to me:πREMπREM [e-mail]πREM πREM I`m on the newsgroups:πREM comp.os.ms-dos.programmerπREM comp.lang.basic.miscπREMπREM Notice: This program automatic sets .bas behind the filnameπREM (This program will make an .qtf file, if you wants to open the file laterπREM just print the filename and this program will open the .qtf file)πREM ▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄πREM I`m just programmingπREM ▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀πDEFINT A-ZπScreenmode = 8πVIEW PRINT 1 TO 25πStartcolor = 10πSCREEN ScreenmodeπON KEY(1) GOSUB helpπKEY(1) ONπSCREEN ScreenmodeπLINE (2, 2)-(2, 630), 7πLINE (3, 2)-(3, 630), 8πLINE (1, 1)-(638, 198), 7, BπLINE (1, 99)-(637, 99)πLINE (0, 0)-(639, 199), 7, BπLINE (2, 197)-(636, 197)πLINE (636, 2)-(636, 2)πLINE (1, 102)-(638, 102), 8πLINE (1, 100)-(638, 101), 7, BπLINE (252, 3)-(252, 21), 8πLINE (352, 2)-(352, 21), 8πLINE (249, 22)-(352, 22), 8πLINE (249, 3)-(249, 21)πLINE (250, 1)-(251, 20), 7, BFπLINE (250, 20)-(350, 21), 7, BFπLINE (350, 1)-(351, 21), 7, BFπLINE (2, 2)-(638, 2), 8πLINE (252, 19)-(348, 19), 15πLINE (349, 3)-(349, 19), 15πCOLOR 7πLOCATE 2, 34: PRINT "Qdraw 5.0"πLOCATE 5, 31: PRINT "Espen Tveit 1996"πLOCATE 15, 10: PRINT "Do not print somthing behind the filname such as .bas"πLOCATE 17, 10: INPUT "File: ", fi$πfile$ = fi$ + ".qtf"πfil$ = fi$ + ".bas"πOPEN fil$ FOR APPEND AS #1πOPEN file$ FOR APPEND AS #2πCLSπcolors% = StartcolorπA = 5πB = 5πPRINT #1, "SCREEN "; Screenmodeπbeveg:πFOR o% = 1 TO 15 STEP 1πP = P + 1πCOLOR o%πLOCATE 23, P: PRINT "█"πCOLOR 15πLOCATE 23, 17: PRINT "Using color:                                         "πCOLOR colors%πLOCATE 23, 17 + 15: PRINT "█"πNEXT o%πCOLOR 15πLOCATE 22, colors%: PRINT ""πDOπIF wh = 1 THENπGOSUB filπEND IFπPSET (A, B), colors%πSELECT CASE INKEY$πCASE "*"πCLOSE #1πCLOSE #2πCLOSE #3πRefresh file$, colors%πCLOSE #1πCLOSE #2πCLOSE #3πOPEN fil$ FOR APPEND AS #1πOPEN file$ FOR APPEND AS #2πCASE "1"πGOSUB sirkelπCASE CHR$(0) + CHR$(83)πN = 1πK = 1πwh = 1πPRINT #2, "P"πPRINT #2, AπPRINT #2, BπPRINT #2, "0"πPRINT #2,πPRINT #2,πPRINT #1, "PSET ("; A; ","; B; "), 0"ππCASE "+"πCOLOR 0πLOCATE 22, colors%: PRINT ""πcolors% = colors% + 1πIF colors% = 16 THEN colors% = 15πCOLOR colors%πCOLOR 15πLOCATE 22, colors%: PRINT ""πCOLOR colors%πLOCATE 23, 17 + 15: PRINT "█"πCASE "-"πCOLOR 0πLOCATE 22, colors%: PRINT ""πcolors% = colors% - 1πIF colors% = 0 THEN colors% = 1πCOLOR colors%πCOLOR 15πLOCATE 22, colors%: PRINT ""πCOLOR colors%πLOCATE 23, 17 + 15: PRINT "█"πCASE CHR$(32)πN = 1πK = 1πwh = 1ππPRINT #2, "P"πPRINT #2, AπPRINT #2, BπPRINT #2, colors%πPRINT #2,πPRINT #2,πPRINT #1, "PSET ("; A; ","; B; "), "; colors%πCASE "3"πBEG = 0πBEG1 = 0πBEG = BEG + AπBEG1 = BEG1 + BπGOSUB firkant1πCASE "4"πBEG = 0πBEG1 = 0πBEG = BEG + AπBEG1 = BEG1 + BπGOSUB strekπCASE "2"πBEG = 0πBEG1 = 0πBEG = BEG + AπBEG1 = BEG1 + BπGOSUB firkantπCASE CHR$(0) + "P"πIF K = 0 THENπPSET (A, B), 0πEND IFπB = B + 1πPSET (A, B), colors%πIF ET = 1 THENπGOSUB lagreπELSEπK = 0πEND IFπCASE "5"πCOLOR colors%πOL = A / 8πOL1 = B / 8πIF OL = 0 THEN OL = 1πIF OL1 = 0 THEN OL1 = 1πLOCATE OL1, OL: INPUT "", f$πIF PEN$ = "I" OR PEN$ = "i" THENπN = 1πK = 1πwh = 1πPRINT #2, "Tekst"πPRINT #2, OL1πPRINT #2, OLπPRINT #2, f$πPRINT #2, colors%πPRINT #2,πELSEπPRINT #1, "COLOR "; colors%πPRINT #1, "LOCATE"; OL1; ","; OL; ":"; "PRINT "; CHR$(34); f$; CHR$(34)πPRINT #1, "COLOR 15"πN = 1πK = 1πwh = 1πPRINT #2, "Tekst"πPRINT #2, OL1πPRINT #2, OLπPRINT #2, f$πPRINT #2, colors%πPRINT #2,πEND IFππCASE CHR$(0) + "K"πIF K = 0 THENπPSET (A, B), 0πEND IFπA = A - 1πPSET (A, B), colors%πIF ET = 1 THENπGOSUB lagreπELSEπK = 0πEND IFπCASE CHR$(27)πPRINT #1, "DO"πPRINT #1, "LOOP"πCLSπENDπCASE CHR$(0) + "M"πIF K = 0 THENπPSET (A, B), 0πEND IFπA = A + 1πPSET (A, B), colors%πIF ET = 1 THENπGOSUB lagreπELSEπK = 0πEND IFπEND SELECTπLOOPππhelp:πCLSπCOLOR 15πVIEW PRINT 1 TO 25πLINE (131, 28)-(131, 28), 7πLINE (131, 28)-(506, 97), 7, BπLINE (506, 98)-(131, 98), 8πLINE (130, 98)-(130, 27), 15πLINE (130, 27)-(506, 27), 15πLINE (507, 27)-(507, 98), 8πLINE (505, 96)-(132, 96), 15πLINE (132, 96)-(132, 29), 8πLINE (505, 29)-(505, 96), 15πLOCATE 1, 23: PRINT "╧  Help for Qdraw 4.0  ╧"πLOCATE 5, 18: PRINT "Push <F1> to get help"πLOCATE 6, 18: PRINT "Push <*> to refresh"πLOCATE 7, 18: PRINT "Push <SPACE> to draw a point on the screen"πLOCATE 8, 18: PRINT "Push <1> to draw an circle"πLOCATE 9, 18: PRINT "Push <2> to draw an square"πLOCATE 10, 18: PRINT "Push <3> to make an filled square"πLOCATE 11, 18: PRINT "Push <4> to make a line"πLOCATE 12, 18: PRINT "Push <5> to set in text"πLOCATE 17, 20: PRINT "Espen Tveit 1996"πLOCATE 23, 18: PRINT "Press a key to continue..."πDOπLOOP WHILE INKEY$ = ""πCLSπP = 0πPSET (A, B), colors%πFOR o% = 1 TO 15 STEP 1πP = P + 1πCOLOR o%πLOCATE 23, P: PRINT "█"πCOLOR 15πLOCATE 23, 17: PRINT "Bruker farge:                                         "πCOLOR colors%πLOCATE 23, 17 + 15: PRINT "█"πNEXT o%πCOLOR 15πLOCATE 22, colors%: PRINT ""πIF wh = 0 THEN RETURNπIF OK1 = 0 THENπOK1 = 1πCLOSE #1πCLOSE #2πOPEN file$ FOR INPUT AS #3πEND IFπDO UNTIL EOF(3)πLINE INPUT #3, valg$πIF valg$ = "T" THENπLINE INPUT #3, rec$πOL1 = VAL(rec$)πLINE INPUT #3, rec$πOL = VAL(rec$)πLINE INPUT #3, rec$πLINE INPUT #3, farge$πKL = VAL(farge$)πCOLOR KLπLOCATE OL1, OL: PRINT rec$πCOLOR 15πEND IFπIF valg$ = "P" THENπ LINE INPUT #3, rec$π G = VAL(rec$)ππ LINE INPUT #3, rec$π H = VAL(rec$)ππ LINE INPUT #3, rec$π LINE INPUT #3, o$π Q = VAL(rec$)π PSET (G, H), QπEND IFπIF valg$ = "BF" THENπLINE INPUT #3, rec$πG = VAL(rec$)πLINE INPUT #3, rec$πH = VAL(rec$)πLINE INPUT #3, rec$πI = VAL(rec$)πLINE INPUT #3, rec$πJ = VAL(rec$)πLINE INPUT #3, rec$πCF = VAL(rec$)πLINE (G, H)-(I, J), CF, BFπEND IFπIF valg$ = "B" THENπLINE INPUT #3, rec$πG = VAL(rec$)πLINE INPUT #3, rec$πH = VAL(rec$)πLINE INPUT #3, rec$πI = VAL(rec$)πLINE INPUT #3, rec$πJ = VAL(rec$)πLINE INPUT #3, rec$πCF = VAL(rec$)πLINE (G, H)-(I, J), CF, BπEND IFππIF valg$ = "Strek" THENπLINE INPUT #3, rec$πG = VAL(rec$)πLINE INPUT #3, rec$πH = VAL(rec$)πLINE INPUT #3, rec$πI = VAL(rec$)πLINE INPUT #3, rec$πJ = VAL(rec$)πLINE INPUT #3, rec$πCF = VAL(rec$)πLINE (G, H)-(I, J), CFπEND IFπIF valg$ = "S" THENπLINE INPUT #3, rec$πG = VAL(rec$)πLINE INPUT #3, rec$πH = VAL(rec$)πLINE INPUT #3, rec$πRADIUS = VAL(rec$)πLINE INPUT #3, rec$πCF = VAL(rec$)πCIRCLE (G, H), RADIUS, CFπEND IFπLOOPπCLOSE #1πCLOSE #2πOPEN fil$ FOR APPEND AS #1πCLOSE #2πOPEN file$ FOR APPEND AS #2πRETURNπππlagre:πN = 1πK = 1πwh = 1ππPRINT #2, "P"πPRINT #2, AπPRINT #2, BπPRINT #2, colors%πPRINT #2,πPRINT #2,πPRINT #1, "PSET ("; A; ","; B; "), "; colors%πRETURNππfirkant:πLINE (BEG, BEG1)-(A, B), colors%, BπDOπSELECT CASE INKEY$πCASE CHR$(0) + "H"πLINE (BEG, BEG1)-(A, B), 0, BπB = B - 1πLINE (BEG, BEG1)-(A, B), colors%, BπCASE CHR$(0) + "P"πLINE (BEG, BEG1)-(A, B), 0, BπB = B + 1πLINE (BEG, BEG1)-(A, B), colors%, BπCASE "+"πCOLOR 0πLOCATE 22, colors%: PRINT ""πcolors% = colors% + 1πCOLOR colors%πCOLOR 15πLOCATE 22, colors%: PRINT ""πCOLOR colors%πLOCATE 23, 17 + 15: PRINT "█"πCASE "-"πCOLOR 0πLOCATE 22, colors%: PRINT ""πcolors% = colors% - 1πCOLOR colors%πCOLOR 15πLOCATE 22, colors%: PRINT ""πCOLOR colors%πLOCATE 23, 17 + 15: PRINT "█"πCASE CHR$(0) + "K"πLINE (BEG, BEG1)-(A, B), 0, BπA = A - 1πLINE (BEG, BEG1)-(A, B), colors%, BπCASE CHR$(0) + "M"πLINE (BEG, BEG1)-(A, B), 0, BπA = A + 1πLINE (BEG, BEG1)-(A, B), colors%, BπCASE CHR$(13)πN = 1πK = 1πwh = 1πPRINT #1, "LINE ("; BEG; ","; BEG1; ")-("; A; ","; B; ") ,"; colors%; ", B"πPRINT #2, "B"πPRINT #2, BEGπPRINT #2, BEG1πPRINT #2, AπPRINT #2, BπPRINT #2, colors%πN = 1πK = 1πwh = 1πRETURNπEND SELECTπLOOPππfirkant1:πLINE (BEG, BEG1)-(A, B), colors%, BFπDOπSELECT CASE INKEY$πCASE CHR$(0) + "H"πLINE (BEG, BEG1)-(A, B), 0, BFπB = B - 1πLINE (BEG, BEG1)-(A, B), colors%, BFπCASE CHR$(0) + "P"πLINE (BEG, BEG1)-(A, B), 0, BFπB = B + 1πLINE (BEG, BEG1)-(A, B), colors%, BFπCASE "+"πCOLOR 0πLOCATE 22, colors%: PRINT ""πcolors% = colors% + 1πIF farge = 16 THEN farge = 15πCOLOR colors%πCOLOR 15πLOCATE 22, colors%: PRINT ""πCOLOR colors%πLOCATE 23, 17 + 15: PRINT "█"πCASE "-"πCOLOR 0πLOCATE 22, colors%: PRINT ""πcolors% = colors% - 1πIF farge = 0 THEN farge = 1πCOLOR colors%πCOLOR 15πLOCATE 22, colors%: PRINT ""πCOLOR colors%πLOCATE 23, 17 + 15: PRINT "█"πCASE CHR$(0) + "K"πLINE (BEG, BEG1)-(A, B), 0, BFπA = A - 1πLINE (BEG, BEG1)-(A, B), colors%, BFπCASE CHR$(0) + "M"πLINE (BEG, BEG1)-(A, B), 0, BFπA = A + 1πLINE (BEG, BEG1)-(A, B), colors%, BFπCASE CHR$(13)πN = 1πK = 1πwh = 1πPRINT #1, "LINE ("; BEG; ","; BEG1; ")-("; A; ","; B; ") ,"; colors%; ", BF"πPRINT #2, "BF"πPRINT #2, BEGπPRINT #2, BEG1πPRINT #2, AπPRINT #2, BπPRINT #2, colors%πN = 1πK = 1πwh = 1πRETURNπEND SELECTπLOOPππstrek:πLINE (BEG, BEG1)-(A, B), colors%πDOπSELECT CASE INKEY$πCASE CHR$(0) + "H"πLINE (BEG, BEG1)-(A, B), 0πB = B - 1πLINE (BEG, BEG1)-(A, B), colors%πCASE CHR$(0) + "P"πLINE (BEG, BEG1)-(A, B), 0πB = B + 1πLINE (BEG, BEG1)-(A, B), colors%πCASE "+"πCOLOR 0πLOCATE 22, colors%: PRINT ""πcolors% = colors% + 1πCOLOR colors%πCOLOR 15πLOCATE 22, colors%: PRINT ""πCOLOR colors%πLOCATE 23, 17 + 15: PRINT "█"πCASE "-"πCOLOR 0πLOCATE 22, colors%: PRINT ""πcolors% = colors% - 1πCOLOR colors%πCOLOR 15πLOCATE 22, colors%: PRINT ""πCOLOR colors%πLOCATE 23, 17 + 15: PRINT "█"πCASE CHR$(0) + "K"πLINE (BEG, BEG1)-(A, B), 0πA = A - 1πLINE (BEG, BEG1)-(A, B), colors%πCASE CHR$(0) + "M"πLINE (BEG, BEG1)-(A, B), 0πA = A + 1πLINE (BEG, BEG1)-(A, B), colors%πCASE CHR$(13)πN = 1πK = 1πwh = 1πPRINT #1, "LINE ("; BEG; ","; BEG1; ")-("; A; ","; B; ") ,"; colors%πPRINT #2, "Strek"πPRINT #2, BEGπPRINT #2, BEG1πPRINT #2, AπPRINT #2, BπPRINT #2, colors%πN = 1πK = 1πwh = 1πRETURNπEND SELECTπLOOPπππsirkel:πDOπSELECT CASE INKEY$πCASE "+"πCOLOR 0πLOCATE 22, plass%: PRINT ""πcolors% = colors% + 1πCOLOR colors%πCOLOR 15πplass% = colors% + 1πLOCATE 22, plass%: PRINT ""πCOLOR colors%πLOCATE 23, 18 + 20: PRINT "█"πCASE "-"πCOLOR 0πLOCATE 22, plass%: PRINT ""πcolors% = colors% - 1πCOLOR colors%πCOLOR 15πplass% = colors% - 1πIF colors% = 0 THENπplass% = 2πcolors% = 1πEND IFπLOCATE 22, plass%: PRINT ""πCOLOR colors%πLOCATE 23, 18 + 20: PRINT "█"πCASE CHR$(0) + "H"πCIRCLE (A, B), RADIUS, 0πRADIUS = RADIUS + 1πCIRCLE (A, B), RADIUS, colors%ππCASE CHR$(0) + "P"πCIRCLE (A, B), RADIUS, 0πRADIUS = RADIUS - 1πIF RADIUS = 0 THEN RADIUS = 1πCIRCLE (A, B), RADIUS, colors%πCASE CHR$(13)πPRINT #1, "CIRCLE ("; A; ","; B; "),"; RADIUS; ","; colors%πwh = 1πPRINT #2, "S"πPRINT #2, AπPRINT #2, BπPRINT #2, RADIUSπPRINT #2, colors%πRETURNπEND SELECTπLOOPππfil:πRETURNππSUB Refresh (file$, colors%)πOPEN file$ FOR INPUT AS #1πP = 0πFOR o% = 1 TO 15 STEP 1πP = P + 1πCOLOR o%πLOCATE 23, P: PRINT "█"πCOLOR 15πLOCATE 23, 17: PRINT "Bruker farge:                                         "πCOLOR colors%πLOCATE 23, 17 + 15: PRINT "█"πNEXT o%πCOLOR 15πLOCATE 22, colors%: PRINT ""ππ  DOπ  IF EOF(1) THENπ  GOTO sluttπEND IFπ  LINE INPUT #1, valg$π  IF valg$ = "T" THENπ  LINE INPUT #1, rec$π  OL1 = VAL(rec$)π  LINE INPUT #1, rec$π  OL = VAL(rec$)π  LINE INPUT #1, rec$π  LINE INPUT #1, farge$π  KL = VAL(farge$)π  COLOR KLπ  LOCATE OL1, OL: PRINT rec$π  COLOR 15π  END IFπ  IF valg$ = "P" THENπ  LINE INPUT #1, rec$π  G = VAL(rec$)π  LINE INPUT #1, rec$π  H = VAL(rec$)π  LINE INPUT #1, rec$π  LINE INPUT #1, o$π  Q = VAL(rec$)π  PSET (G, H), Qπ  END IFππ  IF valg$ = "BF" THENπ  LINE INPUT #1, rec$π  G = VAL(rec$)π  LINE INPUT #1, rec$π  H = VAL(rec$)π  LINE INPUT #1, rec$π  I = VAL(rec$)π  LINE INPUT #1, rec$π  J = VAL(rec$)π  LINE INPUT #1, rec$π  CF = VAL(rec$)π  LINE (G, H)-(I, J), CF, BFπ  END IFπ  IF valg$ = "B" THENπ  LINE INPUT #1, rec$π  G = VAL(rec$)π  LINE INPUT #1, rec$π  H = VAL(rec$)π  LINE INPUT #1, rec$π  I = VAL(rec$)π  LINE INPUT #1, rec$π  J = VAL(rec$)π  LINE INPUT #1, rec$π  CF = VAL(rec$)π  LINE (G, H)-(I, J), CF, Bπ  END IFππ  IF valg$ = "Strek" THENπ  LINE INPUT #1, rec$π  G = VAL(rec$)π  LINE INPUT #1, rec$π  H = VAL(rec$)π  LINE INPUT #1, rec$π  I = VAL(rec$)π  LINE INPUT #1, rec$π  J = VAL(rec$)π  LINE INPUT #1, rec$π  CF = VAL(rec$)π  LINE (G, H)-(I, J), CFπ  END IFπ  IF valg$ = "S" THENπ  LINE INPUT #1, rec$π  G = VAL(rec$)π  LINE INPUT #1, rec$π  H = VAL(rec$)π  LINE INPUT #1, rec$π  RADIUS = VAL(rec$)π  LINE INPUT #1, rec$π  CF = VAL(rec$)π  CIRCLE (G, H), RADIUS, CFπ  END IFπ LOOPπ RETURNππslutt:πEND SUBππAndrew Jones                   BOUNCING WORM                  FidoNet QUIK_BAS Echo          04-14-96 (14:40)       QB, QBasic, PDS        63   1537     WORM.BAS    'Here's a trippy VGA screensaver of a WORM moving on a VGA background.  Heπ'moves and is animated...  One problem is he starts leaving black spotsπ'after awhile, you'll see itππDECLARE SUB animate (qq%)πDEFINT A-ZπSCREEN 13πRANDOMIZE TIMERπd = 8πv = 1πq = 1πx = 160πy = 100πxd = INT(RND * 4) + 2πyd = INT(RND * 4) + 2πIF INT(RND * 10) > 5 THEN xd = -xd ELSE xd = ABS(xd)πIF INT(RND * 10) > 5 THEN yd = -yd ELSE yd = ABS(yd)πFOR t = 0 TO 100πLINE (0, t)-(319, t), 200 - tπLINE (0, 200 - t)-(319, 200 - t), tπ πLINE (t, t)-(319 - t, t), tπLINE (t, 200 - t)-(319 - t, 200 - t), 200 - tπNEXTπDOπIF INT(RND * 30) + 1 = 15 AND xd < 0 THEN xd = xd - 1πIF xd = -1 THEN xd = 2πIF xd = -6 THEN xd = -5πIF INT(RND * 30) + 1 = 15 AND xd > 0 THEN xd = xd + 1πIF xd = 1 THEN xd = -2πIF xd = 6 THEN xd = -5πIF INT(RND * 30) + 1 = 15 AND yd > 0 THEN yd = yd + 1πIF yd = 1 THEN yd = -2πIF yd = -6 THEN yd = -5πIF INT(RND * 30) + 1 = 15 AND yd < 0 THEN yd = yd - 1πIF yd = -1 THEN yd = 2πIF yd = 6 THEN yd = 5πFOR t = 1 TO 8πCIRCLE (x, y), 15 - t, q + tπCIRCLE (x + 1, y), 15 - t, q + tπNEXTπx = x + xdπy = y + ydπIF x < 3 AND xd < 0 THEN xd = ABS(xd)πIF x > 316 AND xd > 0 THEN xd = -xdπIF y < 3 AND yd < 0 THEN yd = ABS(yd)πIF y > 196 AND yd > 0 THEN yd = -ydπq = q + 1πIF q = 255 THEN q = 1πv = v + dπIF v = 400 THEN d = -8πIF v = 0 THEN d = 8πanimate vπLOOPπ πSUB animate (qq)πOUT &H3C8, 1πFOR t = 1 TO 255πOUT &H3C9, (t + qq)πOUT &H3C9, (t + qq) \ 2πOUT &H3C9, (t + qq) \ 4πNEXTπEND SUBπAndrew Jones                   BOX ENLARGES AS BALL BOUNCES   FidoNet QUIK_BAS Echo          04-14-96 (14:42)       QB, QBasic, PDS        62   1347     BOXBALL.BAS 'Sorry about that profanity in BOB.BAS, just saw it as I was cruisingπ'through my programs..eek.. here's an EGA demonstration:)ππDEFINT A-ZπCONST numstars = 30πapage = 0πvpage = 1πx = 0πy = 0πbx = 6πby = 7πd = 1πb = 1πq = 4πDIM sx(numstars)πDIM sy(numstars)πDIM sc(numstars)πSCREEN 7πFOR t = 0 TO numstarsπsx(t) = INT(RND * 320)πsy(t) = INT(RND * 320)πsc(t) = INT(RND * 3) + 1πIF sc(t) = 1 THEN sc(t) = 8πIF sc(t) = 2 THEN sc(t) = 7πIF sc(t) = 3 THEN sc(t) = 15πNEXTπDOπSCREEN 7, , apage, vpageπDRAW "TA" + STR$(b) + "S" + STR$(q)πDRAW "c15bm160,100u20r20c8d20l20c15c8u20c15e10r20e-10d20e10u20"πFOR t = 0 TO numstarsπIF sx(t) = 0 AND sy(t) = 0 THENπsx(t) = INT(RND * 20) + 300πsy(t) = INT(RND * 200)πsc(t) = INT(RND * 3) + 1πIF sc(t) = 1 THEN sc(t) = 8πIF sc(t) = 2 THEN sc(t) = 7πIF sc(t) = 3 THEN sc(t) = 15πEND IFπPSET (sx(t), sy(t)), sc(t)πsx(t) = sx(t) - sc(t)πIF sx(t) < 0 THEN sx(t) = 0: sy(t) = 0πNEXTπx = x + bxπy = y + byπIF x > 320 THEN bx = -bx: x = 320πIF y > 200 THEN by = -by: y = 200πIF x < 0 THEN bx = ABS(bx)πIF y < 0 THEN by = ABS(by)πCIRCLE (x, y), 2, 4πCIRCLE (x, y), 1, 12πCIRCLE (x + 1, y), 2, 4πCIRCLE (x + 1, y), 1, 12πSWAP apage, vpageπSCREEN 7, , apage, vpageπCLS 1πb = b + 10πq = q + dπIF q >= 22 THEN d = -1πIF q = 4 THEN d = 1πIF b >= 360 THEN b = 1πLOOPπAndrew Jones                   SNOWY RAIN                     FidoNet QUIK_BAS Echo          04-14-96 (14:43)       QB, QBasic, PDS        26   529      SNOWRAIN.BAS'Snowy Rain.  I think it's rad, tell me what you think:)ππDEFINT A-ZπON KEY(1) GOSUB fofoπKEY(1) ONπCONST snow = 10πDIM sx(snow)πDIM sy(snow)πSCREEN 13πFOR t = 0 TO snowπsx(t) = INT(RND * 320)πsy(t) = INT(RND * 20)πNEXTπDOπFOR t = 0 TO snowπIF sy(t) = 199 THEN sy(t) = 0: sx(t) = INT(RND * 320): sy(t) = INT(RND * 20)πv = INT(RND * 15) + 1πPSET (sx(t), sy(t)), v + 15πIF v < 6 THEN sx(t) = sx(t) + 1πIF v > 10 THEN sx(t) = sx(t) - 1πsy(t) = sy(t) + 1πIF sy(t) > 199 THEN sy(t) = 199πNEXTπLOOPπfofo:πENDπUnknown Author(s)              MOUSE PAINT PROGRAM            pages.prodigy.com/gamersp      04-01-96 (11:01)       QB, PDS                1238 32348    DRAW!.BAS   'Click the right mouse button to open the menuππ'DRAW! v3.6    'Fixed I/O error, and a betterπ               'printing routine.  Now to printπ               'just press 'P' while in the drawπ               'space and DRAW! will remove theπ               'mouse cursor from the screen andπ               'print it.ππ'NOTE: QB 4.5 user PLEASE LOAD THE QB.QLB library! To do soπ'start QB 4.5 like so at the command prompt:π'C:\QB45>QB /L QBπ'ππ'If you have any trouble loading a .PAL(palette file),π'.PL1-4(EGA BSAVE files), or a .PIC(VGA BSAVE file) please sendπ'me E-MAIL. And just so you know:π'BSAVE files are based on code supplied by Dave Gentry fromπ'VGA LESSON #39. PALette files are simple text format thatπ'support 1 line per color and have 4 segments to a line. Here isπ'the basic format for a PAL file:π'Segment 1:     Segment 2:   Segment 3:   Segment 4:π'The COLOR #    Red value    Green value  Blue valueπ'(These can be read using INPUT #1, CO%,R%,G%,B%)π'Once those values are read into memory use David Gilhams EGA/VGAπ'palette routines:π'OUT &H3C8, CO% 'Selects color to changeπ'OUT &H3C9, R% 'Selects red valueπ'OUT &H3C9, G% 'Selects green valueπ'OUT &H3C9, B% 'Selects blue valueππ'Credits to:π'π'~Dave~ Gentry, for his BLOAD/BSAVE routines!π'David Gillham, for his EGA palette routines.π'πDECLARE SUB PRINTIT ()πDECLARE SUB PALIO (F$)πDECLARE SUB SCREENIO (F$, flag!)πDECLARE SUB SAVEPRINTER (PRNTRTYPE%)πDECLARE SUB PRINTSETUP ()πDECLARE SUB INTRO ()πDECLARE SUB PAINTIT ()πDECLARE SUB COPYIT ()πDECLARE SUB TEXTFONT ()πDECLARE SUB PALETTECHANGE ()πDECLARE SUB WARN (RETURN.CODE%)πDECLARE SUB CHANGESCREENMODE ()πDECLARE SUB ZOBJ (SEL%)πDECLARE SUB PLOT (XX%, YY%, X%, Y%)πDECLARE SUB PLOTX (PX%, PY%)πDECLARE SUB SAVEIT (OP%)πDECLARE SUB ZOOM ()πDECLARE SUB AIRBRUSH ()πDECLARE SUB FONT (TEXT$, X%, Y%, stepX%, stepY%, CO!, Ang%)πDECLARE SUB BUTTON (X1%, Y1%, X2%, Y2%, d%)πDECLARE SUB DOODLE ()πDECLARE SUB DRAWOBJ (OBJ%)πDECLARE SUB POPOPS (SEL%)πDECLARE SUB NEWDIR ()πDECLARE SUB SETCOM ()πDECLARE SUB SETUP ()πDECLARE SUB NEWODIR ()πDECLARE SUB TEXTBOX (BY!, BX!, EY!, EX!, ASCII!, C!, BC!, SHADOW, BS)πDECLARE SUB BOX (BX, BY, EX, EY, B)πDECLARE SUB Pause ()πDECLARE SUB MOUSESTATUS (LB%, RB%, XMOUSE%, YMOUSE%)πDECLARE SUB MouseRange (X1%, Y1%, X2%, Y2%)πDECLARE SUB MousePut (X%, Y%)πDECLARE SUB MOUSEHIDE ()πDECLARE SUB MouseDriver (ax%, BX%, cx%, dx%)πDECLARE SUB MOUSESHOW ()πDECLARE FUNCTION MouseInit% ()πDIM SHARED Mouse$πDIM SHARED THICK%, CO%, SCREENMODE%, PLX%(100), FONTSIZE%πCONST UP = 1πCONST DOWN = 0πCONST ZOOMHELP = 1                'Set to zero to disable ZOOM instructionsπFONTSIZE% = 1                     'Set to default FONT sizeπSCREENMODE% = 7                   'Set to default screen modeππMouse$ = SPACE$(57)πFOR i% = 1 TO 57π  READ a$π  H$ = CHR$(VAL("&H" + a$))π  MID$(Mouse$, i%, 1) = H$πNEXT i%πDATA 55,89,E5,8B,5E,0C,8B,07,50,8B,5E,0A,8B,07,50,8BπDATA 5E,08,8B,0F,8B,5E,06,8B,17,5B,58,1E,07,CD,33,53πDATA 8B,5E,0C,89,07,58,8B,5E,0A,89,07,8B,5E,08,89,0FπDATA 8B,5E,06,89,17,5D,CA,08,00πCLS : THICK% = 10: CO% = 1πms% = MouseInit%πIF NOT ms% THENπ  PRINT "Mouse not found"π  ENDπEND IFπOPEN "DRAW!PAL.TMP" FOR OUTPUT AS #1: CLOSE #1π'ON ERROR GOTO ERRORTRAPπCHANGEIT:πSCREEN SCREENMODE%: PAINT (1, 1), 15: MOUSESHOWπFUNC% = 1πin:πK$ = INKEY$πMOUSESTATUS LB%, RB%, X%, Y%πIF FUNC% > 0 AND FUNC% < 6 THEN DRAWOBJ FUNC%πIF FUNC% = 8 THEN DOODLEπIF FUNC% = 6 THEN AIRBRUSHπIF FUNC% = 7 THEN PAINTITπIF FUNC% = 9 THEN ZOOM: POPOPS FUNC%πIF FUNC% = 10 THEN TEXTFONTπIF RB% = -1 THEN POPOPS FUNC%πIF FUNC% = 99 THEN GOTO CHANGEITπIF K$ <> CHR$(27) THEN GOTO inπDATA G,a,m,e,r,s,'πDATA P,a,r,a,d,i,s,eπDATA S,o,f,t,w,a,r,eπprintcode:πDATA 205, 5, 203  : ' int 5  retf  'Machine-language codeπ                                   'for printing screen.π'ERRORTRAP:π'PRINT "ERROR!! #";ERRπ'RESUME NEXTππSUB AIRBRUSHπRANDOMIZE TIMERπMOUSESTATUS LB%, RB%, X%, Y%πIF LB% = -1 THENπMOUSEHIDEπXX% = INT(RND(1) * THICK%) + 1πYY% = INT(RND(1) * THICK%) + 1πPSET (X% - XX% - 1, Y% - YY% - 1), CO%πMOUSESHOWπEND IFπMOUSESHOWπEND SUBππSUB BUTTON (X1%, Y1%, X2%, Y2%, d%)πIF d% = 1 THEN B1% = 15: B2% = 8πIF d% = 0 THEN B1% = 8: B2% = 15πLINE (X1%, Y1%)-(X2%, Y2%), 7, BFπLINE (X1%, Y1%)-(X2%, Y1%), B1%πLINE (X1%, Y1%)-(X1%, Y2%), B1%πLINE (X2%, Y1%)-(X2%, Y2%), B2%πLINE (X1%, Y2%)-(X2%, Y2%), B2%πEND SUBππSUB CHANGESCREENMODEπREDIM COVERUP5%(7000)πREDIM MODES$(5)πMODES$(1) = "320 X 200 X 16": MODES$(2) = "640 X 200 X 16"πMODES$(3) = "640 X 350 X 16": MODES$(4) = "640 X 480 X 16"πMODES$(5) = "320 X 200 X 256"πGET (14, 14)-(161, 101), COVERUP5%πBUTTON 14, 14, 161, 101, UPπBUTTON 15, 15, 160, 100, UPπBUTTON 17, 17, 30, 30, DOWN: LINE (18, 18)-(29, 29), 0: LINE (18, 29)-(29, 18), 0πBUTTON 32, 17, 158, 30, UP: LINE (33, 18)-(157, 29), 9, BFπFONT "Screen modes", 34, 20, 6, 0, 15, 0πFOR i% = 35 TO 90 STEP 12πa = a + 1πd% = 1πIF a = 1 AND SCREENMODE% = 7 THEN d% = 0πIF a = 2 AND SCREENMODE% = 8 THEN d% = 0πIF a = 3 AND SCREENMODE% = 9 THEN d% = 0πIF a = 4 AND SCREENMODE% = 12 THEN d% = 0πIF a = 5 AND SCREENMODE% = 13 THEN d% = 0πBUTTON 17, i%, 150, i% + 9, d%πFONT MODES$(a), 19, i% + 2, 6, 0, 0, 0πNEXTπMOUSESHOWππWAIT4PRESS2:πLB% = -1πWHILE LB% = -1πMOUSESTATUS LB%, RB%, X%, Y%πWENDπLB% = 0πWHILE LB% = 0πMOUSESTATUS LB%, RB%, X%, Y%πIF RB% = -1 THEN EXIT SUBπWENDπIF X% > 17 AND Y% > 17 AND X% < 30 AND Y% < 30 THEN GOTO ABORTIT4πa = 0πFOR i% = 35 TO 90 STEP 12πa = a + 1πIF X% > 17 AND Y% > i% AND X% < 150 AND Y% < i% + 9 THENπWARN RETURN.CODE%πIF RETURN.CODE% = 1 THEN GOTO ABORTIT4πIF a = 1 THEN SCREENMODE% = 7: GOTO ABORTIT4πIF a = 2 THEN SCREENMODE% = 8: GOTO ABORTIT4πIF a = 3 THEN SCREENMODE% = 9: GOTO ABORTIT4πIF a = 4 THEN SCREENMODE% = 12: GOTO ABORTIT4πIF a = 5 THEN SCREENMODE% = 13: GOTO ABORTIT4πEND IFπNEXTπGOTO WAIT4PRESS2ππABORTIT4:πPUT (14, 14), COVERUP5%, PSETπLB% = -1πWHILE LB% = -1πMOUSESTATUS LB%, RB%, X%, Y%πWENDππEND SUBππSUB DELAYππEND SUBππSUB DOODLEπMOUSESHOWπMOUSESTATUS LB%, RB%, X%, Y%πIF LB% = -1 THEN MOUSEHIDEπIF LB% = -1 THEN LINE (X% - 1, Y% - 1)-(X% - 1 - THICK% - 1, Y% - 1 - THICK% - 1), CO%, BFπIF LB% = -1 THEN MOUSESHOWπEND SUBππSUB DRAWOBJ (OBJ%)πMOUSESHOWπLB% = -1πWHILE LB% = -1πMOUSESTATUS LB%, RB%, X%, Y%πWENDπLB% = 0πWHILE LB% = 0πIF INKEY$ = "p" OR INKEY$ = "P" THEN PRINTITπMOUSESTATUS LB%, RB%, X%, Y%πIF RB% = -1 THEN EXIT SUBπWENDπPLOTX X%, Y%πXX% = X%: YY% = Y%πLB% = -1πWHILE LB% = -1πMOUSESTATUS LB%, RB%, X%, Y%πWENDπLB% = 0πWHILE LB% = 0πIF INKEY$ = "p" OR INKEY$ = "P" THEN PRINTITπMOUSESTATUS LB%, RB%, X%, Y%πIF RB% = -1 THEN GOTO ABORTITπWENDπMOUSEHIDEπPUT (XX% - 4, YY% - 4), PLX%, PSETπIF OBJ% = 1 OR OBJ% = 3 OR OBJ% = 5 THENπFOR i = 0 TO THICK% - 1πIF OBJ% = 1 THEN LINE (XX%, YY% - i)-(X%, Y% - i), CO%πIF OBJ% = 3 THEN LINE (XX%, YY%)-(X%, Y%), CO%, BFπIF OBJ% = 5 AND X% > XX% THEN COLOR CO%: CIRCLE (XX%, YY%), X% - XX%: PAINT (XX%, YY%), CO%πIF OBJ% = 5 AND XX% > X% THEN COLOR CO%: CIRCLE (XX%, YY%), XX% - X%: PAINT (XX%, YY%), CO%πNEXTπEND IFπIF OBJ% = 2 THENπIF XX% < X% AND YY% < Y% OR XX% > X% AND YY% > Y% THENπFOR i = 1 TO THICK%πLINE (XX% + i, YY% + i)-(X% - i, Y% - i), CO%, BπNEXTπEND IFπIF XX% > X% AND YY% < Y% OR XX% < X% AND YY% > Y% THENπFOR i = 1 TO THICK%πLINE (XX% - i, YY% + i)-(X% + i, Y% - i), CO%, BπNEXTπEND IFπEND IFπIF OBJ% = 4 THENπFOR i = 1 TO THICK%πIF OBJ% = 4 AND X% > XX% THEN COLOR CO%: CIRCLE (XX%, YY%), X% - XX% + i: CIRCLE (XX% + 1, YY%), X% - XX% + iπIF OBJ% = 4 AND XX% > X% THEN COLOR CO%: CIRCLE (XX%, YY%), XX% - X% + i: CIRCLE (XX% + 1, YY%), XX% - X% + iπNEXTπEND IFππMOUSESHOWπEXIT SUBπABORTIT:πPUT (XX% - 4, YY% - 4), PLX%, PSETπEND SUBππSUB FONT (TEXT$, X%, Y%, stepX%, stepY%, CO, Ang%)πTEXT$ = UCASE$(TEXT$): T = LEN(TEXT$)πIF Ang% < 4 THEN DRAW "A" + STR$(Ang%)πDRAW "S4;BM" + STR$(X%) + "," + STR$(Y%) + "C" + STR$(CO)π                                                          πFOR C = 1 TO TπSELECT CASE MID$(TEXT$, C, 1)πCASE "A": DRAW "d4u4r4d4u2l4u2"πCASE "B": DRAW "d4r4l4u2r4l4u2r4d4u4l4"πCASE "C": DRAW "r4l4d4r4bu4l4"πCASE "D": DRAW "r4l3d4l1r4u4l4"πCASE "E": DRAW "d4r4l4u2r3l3u2r4l4"πCASE "F": DRAW "d4u2r3l3u2r4l4"πCASE "G": DRAW "r4l4d4r4u2l1r1bu2l4"πCASE "H": DRAW "d4u2r4u2d4u4bl4"πCASE "I": DRAW "r4l2d4l2r4bu4l4"πCASE "J": DRAW "br4d3bd1bl1l3bu4"πCASE "K": DRAW "d4u2r2u1r2u1r1l1d1l2d1l2r2d1r2d1r1bu4bl4"πCASE "L": DRAW "d4r4l4u4"πCASE "M": DRAW "d4u4f2e2d4bu4bl4"πCASE "N": DRAW "d4u4f4u4bl4"πCASE "O": DRAW "d4r4u4l4"πCASE "P": DRAW "d4u4r4d2l4u2"πCASE "Q": DRAW "d4r4u4l4d4r4h1f2h1u4l4"πCASE "R": DRAW "d4u4r4d2l4r2f2h2l2u2"πCASE "S": DRAW "r4l4d2r4d2l4bu4"πCASE "T": DRAW "r4l2d4u4l2"πCASE "U": DRAW "d4r4u4bl4"πCASE "V": DRAW "d2f2e2u2bl4"πCASE "W": DRAW "d4e2f2u4bl4"πCASE "X": DRAW "f4h2g2e4bl4"πCASE "Y": DRAW "f3d1u1e3bl4"πCASE "Z": DRAW "r4g4r4bu4l4"πCASE "1": DRAW "br2d4u4bl2"πCASE "2": DRAW "r3d1g3r3bu4bl4"πCASE "3": DRAW "r4d2l3r3d2l4bu4"πCASE "4": DRAW "d2r4d2u4bl4"πCASE "5": DRAW "r4l4d2r4d2l4bu4"πCASE "6": DRAW "r4l4d4r4u2l4u2"πCASE "7": DRAW "r4d4u4l4"πCASE "8": DRAW "r4d4l4u4d2r4u2l4"πCASE "9": DRAW "r4d4u2l4u2"πCASE "0": DRAW "r4d4l4u4r4g4u4"πEND SELECTπDRAW "BR" + STR$(stepX%)πIF stepY% > 0 THENπDRAW "BD" + STR$(stepY%)πELSEπDRAW "BU" + STR$(ABS(stepY%))πEND IFπNEXT CπDRAW "A0"πEND SUBππSUB INTROπSCREEN 13πFOR i = 1 TO 15: PALETTE i, 0: NEXTπDEF SEG = &HA000π'BLOAD "LOGO320.PIC", 0π'PALIO "LOGO320"πSOUND 2000, .5: SOUND 3000, 1πWHILE INKEY$ = "": WENDπEND SUBππSUB MouseDriver (ax%, BX%, cx%, dx%)π  DEF SEG = VARSEG(Mouse$)π  Mouse% = SADD(Mouse$)π  CALL ABSOLUTE(ax%, BX%, cx%, dx%, Mouse%)πEND SUBππSUB MOUSEHIDEπ ax% = 2π MouseDriver ax%, 0, 0, 0πEND SUBππFUNCTION MouseInit%π  ax% = 0π  MouseDriver ax%, 0, 0, 0π  MouseInit% = ax%πEND FUNCTIONππSUB MousePut (X%, Y%)π  ax% = 4π  cx% = X%π  dx% = Y%π  MouseDriver ax%, 0, cx%, dx%πEND SUBππSUB MouseRange (X1%, Y1%, X2%, Y2%)π  ax% = 7π  cx% = X1%π  dx% = X2%π  MouseDriver ax%, 0, cx%, dx%π  ax% = 8π  cx% = Y1%π  dx% = Y2%π  MouseDriver ax%, 0, cx%, dx%πEND SUBππSUB MOUSESHOWπ  ax% = 1π  MouseDriver ax%, 0, 0, 0πEND SUBππSUB MOUSESTATUS (LB%, RB%, XMOUSE%, YMOUSE%)π  ax% = 3π  MouseDriver ax%, BX%, cx%, dx%π  LB% = ((BX% AND 1) <> 0)π  RB% = ((BX% AND 2) <> 0)π  XMOUSE% = cx%π  YMOUSE% = dx%π  IF SCREENMODE% = 7 OR SCREENMODE% = 13 THEN XMOUSE% = XMOUSE% / 2πEND SUBππSUB PAINTITπMOUSESHOWπLB% = -1πWHILE LB% = -1πMOUSESTATUS LB%, RB%, X%, Y%πWENDπLB% = 0πWHILE LB% = 0πMOUSESTATUS LB%, RB%, X%, Y%πIF RB% = -1 THEN EXIT SUBπWENDπMOUSEHIDEπPAINT (X%, Y%), CO%πMOUSESHOWπEND SUBππSUB PALETTECHANGEπREDIM COVERUP6%(8000)πGET (30, 30)-(170, 135), COVERUP6%πBUTTON 30, 30, 170, 135, UPπBUTTON 32, 32, 46, 46, DOWN: LINE (33, 33)-(45, 45), 0: LINE (33, 45)-(45, 33), 0πBUTTON 48, 32, 168, 46, UPπBUTTON 120, 87, 160, 98, UPπBUTTON 33, 122, 63, 132, UPπBUTTON 70, 122, 100, 132, UPπFONT "SAVE  LOAD", 35, 124, 6, 0, 0, 0πFONT "OK", 130, 91, 6, 0, 0, 0πLINE (49, 33)-(167, 45), 9, BFπFONT "PALETTE", 51, 35, 6, 0, 15, 0πFONT "RED", 32, 60, 6, 0, 12, 0πFONT "GREEN", 32, 75, 6, 0, 10, 0πFONT "BLUE", 32, 90, 6, 0, 9, 0πFOR i% = 55 TO 85 STEP 15πBUTTON 70, i%, 80, i% + 13, UPπBUTTON 83, i%, 103, i% + 13, UPπBUTTON 105, i%, 115, i% + 13, UPπNEXTπFONT "PALETTE WILL CHANGE THE", 32, 100, 6, 0, 0, 0πFONT "VALUE OF THE", 32, 106, 6, 0, 0, 0πCOL = CO%πFONT "CURRENT", 109, 106, 6, 0, COL, 0πFONT "COLOR", 32, 112, 6, 0, 0, 0ππMOUSESHOWππWAIT4PRESS4:πMOUSESHOWπLB% = -1πWHILE LB% = -1πMOUSESTATUS LB%, RB%, X%, Y%πWENDπLB% = 0πWHILE LB% = 0πMOUSESTATUS LB%, RB%, X%, Y%πLINE (120, 60)-(160, 85), CO%, BFπFONT STR$(R%), 82, 60, 6, 0, 0, 0πFONT STR$(G%), 82, 75, 6, 0, 0, 0πFONT STR$(B%), 82, 90, 6, 0, 0, 0πWENDπMOUSEHIDEπIF X% > 33 AND Y% > 122 AND X% < 63 AND Y% < 132 THENπOPEN "DRAW!PAL.TMP" FOR APPEND AS #1πIF CHANGED% <> 0 THEN WRITE #1, CO%, R%, G%, B%πCLOSE #1πSAVEIT 3πEND IFπIF X% > 70 AND Y% > 122 AND X% < 100 AND Y% < 132 THEN SAVEIT 4πIF X% > 120 AND Y% > 87 AND X% < 160 AND Y% < 98 THENπPUT (30, 30), COVERUP6%, PSETπOPEN "DRAW!PAL.TMP" FOR APPEND AS #1πIF R% <> 0 AND G% <> 0 AND B% <> 0 THEN WRITE #1, CO%, R%, G%, B%πCLOSE #1πEXIT SUBπEND IFπIF X% > 32 AND Y% > 32 AND X% < 46 AND Y% < 46 THEN PUT (30, 30), COVERUP6%, PSET: EXIT SUBπIF X% > 70 AND Y% > 55 AND X% < 80 AND Y% < 70 THENπLINE (84, 56)-(102, 67), 7, BFπR% = R% - 1πIF R% = -1 THEN R% = 63πGOSUB CPALπEND IFπIF X% > 105 AND Y% > 55 AND X% < 115 AND Y% < 70 THENπLINE (84, 56)-(102, 67), 7, BFπR% = R% + 1πIF R% = 64 THEN R% = 0πGOSUB CPALπEND IFπIF X% > 70 AND Y% > 70 AND X% < 80 AND Y% < 85 THENπLINE (84, 71)-(102, 82), 7, BFπG% = G% - 1πIF G% = -1 THEN G% = 63πGOSUB CPALπEND IFπIF X% > 105 AND Y% > 70 AND X% < 115 AND Y% < 85 THENπLINE (84, 71)-(102, 82), 7, BFπG% = G% + 1πIF G% = 64 THEN G% = 0πGOSUB CPALπEND IFπIF X% > 70 AND Y% > 85 AND X% < 80 AND Y% < 100 THENπLINE (84, 86)-(102, 97), 7, BFπB% = B% - 1πIF B% = -1 THEN B% = 63πGOSUB CPALπEND IFπIF X% > 105 AND Y% > 85 AND X% < 115 AND Y% < 100 THENπLINE (84, 86)-(102, 97), 7, BFπB% = B% + 1πIF B% = 64 THEN B% = 0πGOSUB CPALπEND IFππGOTO WAIT4PRESS4πCPAL:πCHANGED% = 1π'Special thanks to David Gilham(SP?) for these EGA extended palette routines!πOUT &H3C8, CO% 'Selects color to change  \πOUT &H3C9, R% 'Selects red value         \πOUT &H3C9, G% 'Selects green value       /πOUT &H3C9, B% 'Selects blue value       /πRETURNπEND SUBππSUB PALIO (F$)πF$ = F$ + ".pal"πPALETTEπOPEN F$ FOR APPEND AS #1: CLOSE #1πOPEN F$ FOR INPUT AS #1πWHILE NOT (EOF(1))πINPUT #1, C%, R%, G%, B%πGOSUB CCPALπWENDπCLOSE #1πEXIT SUBππCCPAL:πOUT &H3C8, C% 'Selects color to change  \πOUT &H3C9, R% 'Selects red value         \πOUT &H3C9, G% 'Selects green value       /πOUT &H3C9, B% 'Selects blue value       /πRETURNπππEND SUBππ'This sub used for demo, not needed for mouse callsπSUB Pauseπ  PRINT "Press any key to continue..."π  G$ = INPUT$(1)π  PRINTπEND SUBππSUB PLOT (XX%, YY%, X%, Y%)πMOUSEHIDEπPAINT (XX%, YY%), CO%, 0πPSET (188 + X%, 6 + Y%), CO%πMOUSESHOWπEND SUBππSUB PLOTX (PX%, PY%)πMOUSEHIDEπN = 4πGET (PX% - N, PY% - N)-(PX% + N, PY% + N), PLX%πLINE (PX% - N, PY% - N)-(PX% + N, PY% + N), 0πLINE (PX% + N, PY% - N)-(PX% - N, PY% + N), 0πMOUSESHOWπEND SUBππSUB POPOPS (FUNC%)πTHEWHOLETHING:πIF SCREENMODE% = 13 THEN REDIM COVERUP1%(31000)πIF SCREENMODE% <> 13 THEN REDIM COVERUP1%(13000)πMOUSEHIDEπGET (1, 1)-(319, 150), COVERUP1%πBUTTON 1, 1, 319, 150, UPπBUTTON 2, 2, 318, 149, UPπBUTTON 5, 5, 18, 18, DOWN: LINE (6, 6)-(17, 17), 0: LINE (6, 17)-(17, 6), 0πBUTTON 21, 5, 316, 18, UP: LINE (22, 6)-(315, 17), 9, BFπBUTTON 130, 132, 175, 142, UPπBUTTON 190, 132, 210, 142, UPπBUTTON 178, 132, 188, 142, UPπBUTTON 212, 132, 222, 142, UPπBUTTON 225, 132, 300, 142, UPπFONT "Tools", 24, 9, 7, 0, 15, 0πREDRAW:πFONT "PALETTE", 132, 135, 6, 0, 0, 0πFONT "Screen mode", 227, 135, 6, 0, 0, 0πa% = 0πMOUSEHIDEπFOR i% = 5 TO 250 STEP 40πa% = a% + 1πBUTTON i%, 20, i% + 38, 50, UPπIF a% = FUNC% THEN BUTTON i%, 20, i% + 38, 50, DOWNπNEXTπFOR i% = 5 TO 175 STEP 40πa% = a% + 1πBUTTON i%, 53, i% + 38, 83, UPπIF a% = FUNC% THEN BUTTON i%, 53, i% + 38, 83, DOWNπNEXTπIF SCREENMODE% <> 13 THENπFOR i = 5 TO 235 STEP 15πC = C + 1πLINE (i, 85)-(i + 14, 100), C - 1, BFπCS% = 0πIF C - 1 = CO% THEN CS% = 14πLINE (i, 85)-(i + 14, 100), CS%, BπNEXTπC = 0πEND IFπIF SCREENMODE% = 13 THENπFOR a = 0 TO 4πFOR i = 5 TO 295 STEP 5πC = C + 1πIF C > 255 THEN GOTO NXTπLINE (i, 85 + 11 * a)-(i + 5, 96 + 11 * a), C - 1, BFπCS% = 0πIF C - 1 = CO% THEN CS% = 14πLINE (i, 85 + 11 * a)-(i + 5, 96 + 11 * a), CS%, BπNXT:πNEXTπNEXTπEND IFπLINE (7, 21)-(42, 49), 9πLINE (48, 22)-(80, 48), 4, BπLINE (88, 22)-(120, 48), 14, BFπCOLOR 10: CIRCLE (144, 35), 16πCOLOR 11: CIRCLE (184, 35), 16: PAINT (184, 35), 11πLINE (215, 30)-(225, 48), 0, B: LINE (221, 33)-(225, 45), 0, B: PAINT (222, 34), 4, 0πLINE (215, 30)-(217, 28), 0: LINE (217, 28)-(223, 28), 0: LINE (223, 28)-(225, 30), 0πLINE (220, 27)-(221, 26), 15, BFπFONT "PAINT", 248, 27, 6, 0, 12, 0πFONT "DOODLE", 7, 60, 6, 0, 10, 0πFONT "ZOOM", 53, 60, 6, 0, 9, 0πFONT "ABC", 90, 60, 6, 0, 1, 0πFONT "SAVE", 130, 60, 6, 0, 0, 0πFONT "LOAD", 170, 60, 6, 0, 0, 0πBUTTON 210, 60, 250, 70, UPπBUTTON 255, 60, 290, 70, UPπBUTTON 210, 72, 290, 82, UPπFONT "EXIT", 215, 62, 6, 0, 0, 0πFONT "UNDO", 260, 62, 6, 0, 0, 0πFONT "PRINTER SETUP", 212, 74, 6, 0, 0, 0ππLB% = -1πWHILE LB% = -1πMOUSESTATUS LB%, RB%, X%, Y%πWENDππWAIT4PRESS:πFONT STR$(THICK%), 188, 136, 6, 0, 0, 0πMOUSESHOWπMOUSESTATUS LB%, RB%, X%, Y%πIF LB% = -1 THENπMOUSEHIDEπIF X% > 210 AND Y% > 72 AND X% < 290 AND Y% < 82 THEN PRINTSETUPπIF X% > 210 AND Y% > 60 AND X% < 250 AND Y% < 70 THEN SYSTEMπIF X% > 130 AND Y% > 132 AND X% < 175 AND Y% < 142 THEN PALETTECHANGEπIF X% > 225 AND Y% > 132 AND X% < 300 AND Y% < 142 THENπOSC% = SCREENMODE%πCHANGESCREENMODEπIF OSC% <> SCREENMODE% THEN FUNC% = 99: EXIT SUBπEND IFπIF X% > 178 AND Y% > 132 AND X% < 188 AND Y% < 142 AND LB% = -1 THENπTHICK% = THICK% - 1πIF THICK% = 0 THEN THICK% = 1πBUTTON 190, 132, 210, 142, UPπGOSUB DELAYπGOTO WAIT4PRESSπEND IFπIF X% > 212 AND Y% > 132 AND X% < 222 AND Y% < 142 AND LB% = -1 THENπTHICK% = THICK% + 1πIF THICK% = 25 THEN THICK% = 24πBUTTON 190, 132, 210, 142, UPπGOSUB DELAYπGOTO WAIT4PRESSπEND IFππIF SCREENMODE% <> 13 THENπFOR i = 5 TO 235 STEP 15πC = C + 1πIF SCREENMODE% <> 13 AND X% > i AND Y% > 85 AND X% < i + 14 AND Y% < 100 THEN CO% = C - 1πNEXTπC = 0πEND IFπC = 0πIF SCREENMODE% = 13 THENπFOR a = 0 TO 4πFOR i = 5 TO 295 STEP 5πC = C + 1πIF X% > i AND Y% > 85 + 11 * a AND X% < i + 5 AND Y% < 96 + 11 * a THEN CO% = C - 1πNEXTπNEXTπC = 0πEND IFππa% = 0πIF X% > 5 AND Y% > 5 AND X% < 18 AND Y% < 18 THEN GOTO ABORTIT2πFOR i% = 5 TO 250 STEP 40πa% = a% + 1πIF X% > i% AND Y% > 20 AND X% < i% + 38 AND Y% < 50 THEN LF% = FUNC%: FUNC% = a%πIF a% = FUNC% THEN BUTTON i%, 20, i% + 38, 50, DOWNπNEXTπFOR i% = 5 TO 170 STEP 40πa% = a% + 1πIF X% > i% AND Y% > 53 AND X% < i% + 38 AND Y% < 83 THEN LF% = FUNC%: FUNC% = a%πIF a% = FUNC% THEN BUTTON i%, 53, i% + 38, 83, DOWNπNEXTπIF FUNC% = 11 THEN PUT (1, 1), COVERUP1%, PSET: SAVEIT 1: FUNC% = LF%: GOTO THEWHOLETHINGπIF FUNC% = 12 THEN PUT (1, 1), COVERUP1%, PSET: SAVEIT 2: FUNC% = LF%: GOTO THEWHOLETHINGπIF X% > 255 AND Y% > 60 AND X% < 290 AND Y% < 70 THEN PUT (1, 1), COVERUP1%, PSET: SAVEIT 6: FUNC% = LF%: MOUSESHOW: GOTO THEWHOLETHINGππMOUSESHOWπGOTO REDRAWπEND IFπGOTO WAIT4PRESSπABORTIT2:πLB% = -1πWHILE LB% = -1πMOUSESTATUS LB%, RB%, X%, Y%πWENDπMOUSEHIDEπPUT (1, 1), COVERUP1%, PSETπSAVEIT 5πMOUSESHOWπERASE COVERUP1%πEXIT SUBπDELAY:πLB% = -1πWHILE LB% = -1πMOUSESTATUS LB%, RB%, X%, Y%πWENDπRETURNπEND SUBππSUB PRINTITπRESTORE printcodeπMOUSEHIDEπ    REDIM a%(2)π    DEF SEG = VARSEG(a%(0))π    FOR i% = 0 TO 2π       READ d%π       POKE VARPTR(a%(0)) + i%, d%π    NEXT i%π    CALL ABSOLUTE(VARPTR(a%(0)))π    DEF SEGπMOUSESHOWπEND SUBππSUB PRINTSETUPπOPEN "DRAWPRNT.STP" FOR APPEND AS #1: CLOSE #1πOPEN "DRAWPRNT.STP" FOR INPUT AS #1πWHILE NOT (EOF(1))πINPUT #1, PRN%πWENDπCLOSE #1πIF PRN% = 0 THEN PRN% = 1πREDIM PR$(18), DRV$(18)πPR$(1) = "IBM B/W Printer": DRV$(1) = "COLOR1"πPR$(2) = "IBM RGB Printer": DRV$(2) = "COLOR4"πPR$(3) = "IBM CMY Printer": DRV$(3) = "COLOR8"πPR$(4) = "HP PCL Default": DRV$(4) = "HPDEFAULT"πPR$(5) = "HP Deskjet": DRV$(5) = "DESKJET"πPR$(6) = "IBM PROprinter": DRV$(6) = "GRAPHICS"πPR$(7) = "IBM Quietwriter": DRV$(7) = "GRAPHICS"πPR$(8) = "IBM Graphics WIDE": DRV$(8) = "GRAPHICSWIDE"πPR$(9) = "HP Laserjet": DRV$(9) = "LASERJET"πPR$(10) = "HP Laserjet II": DRV$(10) = "LASERJETII"πPR$(11) = "HP Paintjet": DRV$(11) = "PAINTJET"πPR$(12) = "HP Quitjet": DRV$(12) = "QUIETJET"πPR$(13) = "HP Quitjet plus": DRV$(13) = "QUIETJETPLUS"πPR$(14) = "HP Ruggedwriter": DRV$(14) = "RUGGEDWRITER"πPR$(15) = "HP Ruggedwriterwide": DRV$(15) = "RUGGEDWRITERWIDE"πPR$(16) = "IBM Thermal printer": DRV$(16) = "THERMAL"πPR$(17) = "HP Thinkjet": DRV$(17) = "THINKJET"πREDIM COVERUP8%(10000)πGET (18, 18)-(200, 90), COVERUP8%πBUTTON 18, 18, 200, 90, UPπFONT "TO PRINT MOVE MOUSE OFF SCREEN", 20, 75, 6, 0, 0, 0πFONT "AND PRESS SHIFT PRNT SCRN", 20, 82, 6, 0, 0, 0πBUTTON 20, 20, 34, 34, DOWN: LINE (21, 21)-(33, 33), 0: LINE (21, 33)-(33, 21), 0πBUTTON 36, 20, 198, 34, UP: LINE (37, 21)-(197, 33), 9, BFπFONT "PRINTER SETUP", 38, 22, 6, 0, 15, 0πBUTTON 30, 40, 40, 55, UPπBUTTON 45, 40, 160, 55, UPπBUTTON 165, 40, 175, 55, UPπBUTTON 70, 58, 110, 68, UPπFONT "OK", 85, 60, 6, 0, 0, 0πWAIT4PRESS6:πMOUSESHOWπLB% = -1πWHILE LB% = -1πMOUSESTATUS LB%, RB%, X%, Y%πWENDπLB% = 0πWHILE LB% = 0πMOUSESTATUS LB%, RB%, X%, Y%πFONT PR$(PRN%), 47, 42, 6, 0, 0, 0πWENDπIF X% > 70 AND Y% > 58 AND X% < 110 AND Y% < 68 THENπPUT (18, 18), COVERUP8%, PSETπOPEN "DRAWPRNT.STP" FOR OUTPUT AS #1πWRITE #1, PRN%πSHELL "GRAPHICS " + DRV$(PRN%) + " /R"πCLOSE #1ππEXIT SUBπEND IFπIF X% > 20 AND Y% > 20 AND X% < 34 AND Y% < 34 THEN PUT (18, 18), COVERUP8%, PSET: EXIT SUBπIF X% > 30 AND Y% > 40 AND X% < 40 AND Y% < 55 THENπPRN% = PRN% - 1πIF PRN% = 0 THEN PRN% = 1πBUTTON 45, 40, 160, 55, UPπEND IFπIF X% > 165 AND Y% > 40 AND X% < 175 AND Y% < 55 THENπPRN% = PRN% + 1πIF PRN% = 18 THEN PRN% = 17πBUTTON 45, 40, 160, 55, UPπEND IFπππGOTO WAIT4PRESS6πEND SUBππSUB SAVEIT (OP%)πIF OP% = 5 THEN F2$ = "DRAWUNDO": OP% = 1: GOTO UNDOSAVEπIF OP% = 6 THEN F2$ = "DRAWUNDO": OP% = 2: GOTO UNDOSAVEπREDIM COVERUP2%(10000)πMOUSEHIDEπGET (1, 1)-(202, 55), COVERUP2%πBUTTON 1, 1, 202, 55, UPπIF SCREENMODE% = 7 OR SCREENMODE% = 9 OR SCREENMODE% = 8 THEN COLOR 15, 7πLOCATE 2, 2: PRINT "Filename(NO EXTENSION!):"πCOLOR 9πREIN:πLOCATE 3, 2: PRINT "              "πLOCATE 3, 2: INPUT "", FILENAME$πF2$ = FILENAME$πIF LEN(FILENAME$) > 8 THEN GOTO REINπPUT (1, 1), COVERUP2%, PSETπUNDOSAVE:πMOUSESHOWπIF SCREENMODE% = 7 OR SCREENMODE% = 9 OR SCREENMODE% = 8 THEN COLOR 15, 0πIF OP% = 3 THENπOPEN "DRAW!PAL.TMP" FOR INPUT AS #2πOPEN F2$ + ".PAL" FOR APPEND AS #3πWHILE NOT (EOF(2))πINPUT #2, RC%, RR%, RG%, RB%πWRITE #3, RC%, RR%, RG%, RB%πWENDπCLOSE #2: CLOSE #3πMOUSESHOWπEND IFπIF OP% = 4 THENπCLOSEπOPEN F2$ + ".PAL" FOR INPUT AS #1πWHILE NOT (EOF(1))πINPUT #1, CO%, R%, G%, B%π'Special thanks to David Gilham(SP?) for these EGA extended palette routines!πOUT &H3C8, CO% 'Selects color to change  \πOUT &H3C9, R% 'Selects red value         \πOUT &H3C9, G% 'Selects green value       /πOUT &H3C9, B% 'Selects blue value       /πWENDπCLOSEπMOUSESHOWπEND IFπIF OP% = 1 AND SCREENMODE% = 13 THENπDEF SEG = &HA000πBSAVE F2$ + ".PIC", 0, 64000πEND IFπIF OP% = 1 AND SCREENMODE% > 6 AND SCREENMODE% < 13 THEN SCREENIO F2$, 1: EXIT SUBπIF OP% = 2 AND SCREENMODE% = 13 THENπDEF SEG = &HA000πBLOAD F2$ + ".PIC", 0πEND IFπIF OP% = 2 AND SCREENMODE% > 6 AND SCREENMODE% < 13 THEN SCREENIO F2$, 0: EXIT SUBπEND SUBππSUB SAVEPRINTER (PRNTRTYPE%)πEND SUBππSUB SCREENIO (F$, flag)π  DEF SEG = &H40π  VidMode = PEEK(&H49)π  PageAddr& = PEEK(&H4E) + PEEK(&H4F) * 256&π  PageSize& = PEEK(&H4C) + PEEK(&H4D) * 256&π  IF VidMode = 19 THEN PageSize& = 64000π  DEF SEGπ  SELECT CASE VidModeπ    CASE 3, 4, 6   'SCREEN 0,1,2           π      DEF SEG = &HB800: GOSUB ScreenIO1: DEF SEGπ    CASE 13 TO 19  'SCREEN 7 to 13         π      DEF SEG = &HA000π      IF VidMode = 19 THENπ        GOSUB ScreenIO1π      ELSEπ        FOR p = 0 TO 3π          IF flag THENπ            OUT &H3CE, 4: OUT &H3CF, pπBSAVE F$ + ".PL" + LTRIM$(STR$(p)), PageAddr&, PageSize&π          ELSEπ            OUT &H3C4, 2: OUT &H3C5, 2 ^ pπ          BLOAD F$ + ".PL" + LTRIM$(STR$(p)), PageAddr&π          END IFπ          IF p = 1 AND VidMode = 15 THEN EXIT FORπ        NEXTπ      END IFπ      DEF SEGπ  END SELECTπ  EXIT SUBπScreenIO1:                                 π  IF flag THEN BSAVE F$ + ".SCR", PageAddr&, PageSize&'Goes on above line'-> ELSE BLOAD f$ + ".SCR", PageAddr&π  RETURNππEND SUBππSUB TEXTFONTπREDIM COVERUP7%(10000)πGET (1, 1)-(318, 60), COVERUP7%πMOUSESHOWπLB% = -1πWHILE LB% = -1πMOUSESTATUS LB%, RB%, X%, Y%πWENDπLB% = 0πWHILE LB% = 0πMOUSESTATUS LB%, RB%, X%, Y%πIF RB% = -1 THEN EXIT SUBπWENDπMOUSEHIDEπBUTTON 1, 1, 318, 60, UPπBUTTON 3, 3, 17, 17, DOWN: LINE (4, 4)-(16, 16), 0: LINE (4, 16)-(16, 4), 0πBUTTON 19, 3, 316, 17, UP: LINE (20, 4)-(315, 16), 9, BFπBUTTON 135, 45, 145, 55, UPπBUTTON 148, 45, 163, 55, UPπBUTTON 166, 45, 176, 55, UPπBUTTON 180, 45, 220, 55, UPπFONT STR$(FONTSIZE%), 145, 48, 6, 0, 0, 0πFONT "OK", 195, 48, 6, 0, 0, 0πFONT "Enter text", 22, 6, 6, 0, 15, 0πIF SCREENMODE% < 10 THEN COLOR CO%, 0πIF SCREENMODE% > 10 THEN COLOR CO%πLOCATE 4, 2: PRINT STRING$(38, " ")πLOCATE 5, 2: PRINT STRING$(38, " ")πMOUSESHOWπLOCATE 4, 2: LINE INPUT "", DUMMY$πLOCATE 5, 2: LINE INPUT "", DUMMY$πFONT "PRESS 'OK' WHEN READY", 5, 50, 6, 0, 12, 0πMOUSEHIDEπREDIM LINE1%(304, 8)πREDIM LINE2%(304, 8)ππFOR XX% = 8 TO 311πa% = a% + 1πFOR YY% = 24 TO 31πB% = B% + 1πLINE1%(a%, B%) = POINT(XX%, YY%)πNEXTπB% = 0πNEXTπa% = 0: B% = 0πFOR XX% = 8 TO 311πa% = a% + 1πFOR YY% = 32 TO 39πB% = B% + 1πLINE2%(a%, B%) = POINT(XX%, YY%)πNEXTπB% = 0πNEXTππOX% = X%: OY% = Y%πππWAIT4PRESS5:πMOUSESHOWπLB% = -1πWHILE LB% = -1πMOUSESTATUS LB%, RB%, X%, Y%πWENDπLB% = 0πWHILE LB% = 0πMOUSESTATUS LB%, RB%, X%, Y%πFONT STR$(FONTSIZE%), 145, 48, 6, 0, 0, 0πWENDπMOUSEHIDEπIF X% > 3 AND Y% > 3 AND X% < 17 AND Y% < 17 THEN PUT (1, 1), COVERUP7%, PSET: EXIT SUBπIF X% > 180 AND Y% > 45 AND X% < 220 AND Y% < 55 THEN GOTO PRINTFONTπIF X% > 135 AND Y% > 45 AND X% < 145 AND Y% < 55 THENπFONTSIZE% = FONTSIZE% - 2πIF FONTSIZE% < 0 THEN FONTSIZE% = 1πBUTTON 148, 45, 163, 55, UPπGOTO WAIT4PRESS5πEND IFππIF X% > 166 AND Y% > 45 AND X% < 176 AND Y% < 55 THENπFONTSIZE% = FONTSIZE% + 2πIF FONTSIZE% > 23 THEN FONTSIZE% = 23πBUTTON 148, 45, 163, 55, UPπGOTO WAIT4PRESS5πEND IFππGOTO WAIT4PRESS5πππPRINTFONT:πS% = FONTSIZE% - 1πa% = 0: B% = 0πMOUSEHIDEπPUT (1, 1), COVERUP7%, PSETπFOR X = 8 TO 311πa% = a% + 1πFOR Y = 24 TO 31πB% = B% + 1πIF LINE1%(a%, B%) = 0 THEN GOTO NXT2πi = S%πIF i > 1 THEN LINE (OX% + a% * i, OY% + B% * i)-(OX% + a% * i + S%, OY% + B% * i + S%), LINE1%(a%, B%), BFπIF i < 3 THEN PSET (OX% + a%, OY% + B%), LINE1%(a%, B%)πIF i > 1 THEN LX% = a% * iπIF i < 3 THEN LX% = a%πNXT2:πNEXTπB% = 0πNEXTπa% = 0: B% = 0πOX% = OX% + LX%πFOR X = 8 TO 311πa% = a% + 1πFOR Y = 24 TO 31πB% = B% + 1πIF LINE2%(a%, B%) = 0 THEN GOTO NXT3πi = S%πLX% = LX% + 1πIF i > 1 THEN LINE (OX% + a% * i, OY% + B% * i)-(OX% + a% * i + S%, OY% + B% * i + S%), LINE2%(a%, B%), BFπIF i < 3 THEN PSET (OX% + a%, OY% + B%), LINE2%(a%, B%)πNXT3:πNEXTπB% = 0πNEXTππMOUSESHOWππEND SUBππSUB WARN (RETURN.CODE%)πREDIM WARNING%(6000)πGET (20, 20)-(140, 80), WARNING%πMOUSEHIDEπBUTTON 20, 20, 140, 80, UPπBUTTON 22, 22, 35, 35, DOWN: LINE (23, 23)-(34, 34), 0: LINE (23, 34)-(34, 23), 0πBUTTON 37, 22, 138, 35, UP: LINE (38, 23)-(137, 34), 9, BFπFONT "WARNING", 39, 25, 6, 0, 15, 0πFONT "Changing screen", 25, 38, 6, 0, 0, 0πFONT "modes means lose", 25, 45, 6, 0, 0, 0πFONT "PICTURE", 25, 51, 6, 0, 0, 0πBUTTON 27, 67, 70, 77, UPπBUTTON 73, 67, 113, 77, UPπFONT "PROCEED", 29, 70, 6, 0, 0, 0πFONT "CANCEL", 75, 70, 6, 0, 0, 0πMOUSESHOWπWAIT4PRESS3:πLB% = -1πWHILE LB% = -1πMOUSESTATUS LB%, RB%, X%, Y%πWENDπLB% = 0πWHILE LB% = 0πMOUSESTATUS LB%, RB%, X%, Y%πIF RB% = -1 THEN EXIT SUBπWENDπIF X% > 27 AND Y% > 67 AND X% < 70 AND Y% < 77 THEN RETURN.CODE% = 0: EXIT SUBπIF X% > 73 AND Y% > 67 AND X% < 113 AND Y% < 77 THEN RETURN.CODE% = 1: EXIT SUBπIF X% > 22 AND Y% > 22 AND Y% < 35 AND Y% < 35 THEN RETURN.CODE% = 0: EXIT SUBπGOTO WAIT4PRESS3πEND SUBππSUB ZOBJ (SEL%)πLB% = -1πWHILE LB% = -1πMOUSESTATUS LB%, RB%, X%, Y%πWENDπLB% = 0πWHILE LB% = 0πMOUSESTATUS LB%, RB%, X%, Y%πIF LB% = -1 AND X% > 4 AND Y% > 4 AND X% < 18 AND Y% < 18 THEN EXIT SUBπIF RB% = -1 THEN EXIT SUBπWENDππFOR XX% = 5 TO 180 STEP 5πa% = a% + 1πFOR YY% = 20 TO 145 STEP 5πB% = B% + 1πIF X% > XX% AND Y% > YY% AND X% < XX% + 5 AND Y% < YY% + 5 THEN PLOT X%, Y%, a%, B%: GOTO FOUNDITπNEXTπB% = 0πNEXTπFOUNDIT:πOX% = a%: OY% = B%πa% = 0: B% = 0: X% = 0: Y% = 0: XX% = 0: YY% = 0πLB% = -1πWHILE LB% = -1πMOUSESTATUS LB%, RB%, X%, Y%πWENDπLB% = 0πWHILE LB% = 0πMOUSESTATUS LB%, RB%, X%, Y%πIF RB% = -1 THEN EXIT SUBπWENDππFOR XX% = 5 TO 180 STEP 5πa% = a% + 1πFOR YY% = 20 TO 145 STEP 5πB% = B% + 1πIF X% > XX% AND Y% > YY% AND X% < XX% + 5 AND Y% < YY% + 5 THEN PLOT X%, Y%, a%, B%: GOTO FOUNDIT2πNEXTπB% = 0πNEXTπFOUNDIT2:ππIF SEL% = 1 THEN LINE (188 + OX%, 6 + OY%)-(188 + a%, 6 + B%), CO%πIF SEL% = 2 THEN LINE (188 + OX%, 6 + OY%)-(188 + a%, 6 + B%), CO%, BπIF SEL% = 3 THEN LINE (188 + OX%, 6 + OY%)-(188 + a%, 6 + B%), CO%, BFππX% = 188: Y% = 6πMOUSEHIDEπREDIM ZOOMM(35, 25)πFOR CAPX = 1 TO 35πFOR CAPY = 1 TO 25πZOOMM(CAPX, CAPY) = POINT(X% + CAPX, Y% + CAPY)πNEXTπNEXTππFOR X = 5 TO 175 STEP 5πXX = XX + 1πFOR Y = 20 TO 140 STEP 5πYY = YY + 1πPAINT (X + 1, Y + 1), ZOOMM(XX, YY), 0πPSET (188 + XX, 6 + YY), ZOOMM(XX, YY)πNEXTπYY = 0πNEXTπMOUSESHOWππEND SUBππSUB ZOOMπIF ZOOMHELP = 1 THENπREDIM HELP%(15000)πMOUSEHIDEπGET (1, 1)-(200, 100), HELP%πBUTTON 1, 1, 200, 100, UPπBUTTON 2, 2, 199, 99, UPπBUTTON 4, 4, 18, 18, DOWN: LINE (5, 5)-(17, 17), 0: LINE (5, 17)-(17, 5), 0πBUTTON 20, 4, 197, 18, UP: LINE (21, 5)-(196, 17), 9, BFπFONT "ZOOM Instructions", 22, 9, 6, 0, 15, 0πFONT "To disable these instructions", 6, 20, 6, 0, 4, 0πFONT "set the CONSTant ZOOMHELP to 0", 6, 26, 6, 0, 4, 0πFONT "Using ZOOM is easy. To ZOOM into", 6, 35, 6, 0, 10, 0πFONT "a specific region use the mouse", 6, 41, 6, 0, 10, 0πFONT "to select the upper-right corner", 6, 47, 6, 0, 10, 0πFONT "of that area. DRAW! will capture", 6, 53, 6, 0, 10, 0πFONT "34x25 pixels from that point", 6, 59, 6, 0, 10, 0πDO WHILE INKEY$ = ""πMOUSESHOWπMOUSESTATUS LB%, RB%, X%, Y%πIF LB% = -1 AND X% > 4 AND Y% > 4 AND X% < 18 AND Y% < 18 THEN EXIT DOπLOOPπMOUSEHIDEπPUT (1, 1), HELP%, PSETπERASE HELP%πMOUSESHOWπEND IFππLB% = -1πWHILE LB% = -1πMOUSESTATUS LB%, RB%, X%, Y%πWENDπLB% = 0πWHILE LB% = 0πMOUSESTATUS LB%, RB%, X%, Y%πIF RB% = -1 THEN EXIT SUBπWENDπXXX% = X%: YYY% = Y%πMOUSEHIDEπREDIM COVERUP3%(14000)πREDIM COVERUP4%(5000)πGET (187, 5)-(225, 33), COVERUP4%πGET (2, 2)-(183, 151), COVERUP3%πREDIM ZOOMM(35, 25)πFOR CAPX = 1 TO 35πFOR CAPY = 1 TO 25πZOOMM(CAPX, CAPY) = POINT(X% + CAPX, Y% + CAPY)πNEXTπNEXTπBUTTON 2, 2, 183, 151, UPπBUTTON 187, 5, 225, 33, UPπBUTTON 4, 4, 18, 18, DOWN: LINE (5, 5)-(17, 17), 0: LINE (5, 17)-(17, 5), 0πBUTTON 20, 4, 181, 18, UP: LINE (21, 5)-(180, 17), 9, BFπFONT "ZOOM EDITOR", 23, 8, 6, 0, 15, 0πFOR X = 5 TO 180 STEP 5πLINE (X, 20)-(X, 145), 0πNEXTπFOR Y = 20 TO 145 STEP 5πLINE (5, Y)-(180, Y), 0πNEXTπFOR X = 5 TO 175 STEP 5πXX = XX + 1πFOR Y = 20 TO 140 STEP 5πYY = YY + 1πPAINT (X + 1, Y + 1), ZOOMM(XX, YY), 0πPSET (188 + XX, 6 + YY), ZOOMM(XX, YY)πNEXTπYY = 0πNEXTπMOUSESHOWπIN02:πMOUSESTATUS LB%, RB%, X%, Y%πa% = 0: B% = 0πIF LB% = -1 AND X% > 4 AND Y% > 4 AND X% < 18 AND Y% < 18 THEN GOTO ABORTIT3πIF RB% = -1 THENπPOPOPS ZFUNC%πMOUSESHOWπEND IFπIF ZFUNC% > 0 AND ZFUNC% < 6 THEN ZOBJ ZFUNC%πIF LB% = -1 AND ZFUNC% = 0 THENπFOR XX% = 5 TO 175 STEP 5πa% = a% + 1πFOR YY% = 20 TO 140 STEP 5πB% = B% + 1πIF X% > XX% AND Y% > YY% AND X% < XX% + 5 AND Y% < YY% + 5 THEN PLOT X%, Y%, a%, B%πNEXTπB% = 0πNEXTπEND IFπGOTO IN02πABORTIT3:πMOUSEHIDEπREDIM EDITED%(5000)πGET (189, 7)-(223, 31), EDITED%πPUT (187, 5), COVERUP4%, PSETπPUT (2, 2), COVERUP3%, PSETπPUT (XXX% + 1, YYY% + 1), EDITED%, PSETπERASE EDITED%πERASE COVERUP4%πERASE COVERUP3%πMOUSESHOWπEND SUBπJames Tonn                     TILE GRAPHICS                  www.geocities.com/SiliconVally/08/94 (00:00)          QB, QBasic, PDS        306  13876    TILEEX.BAS  'This is a small program using tile graphics. This source code is the propertyπ'of James Tonn. You may modify this source code and use it in your ownπ'programs. You may use it in a written publication provided that it is notπ'altered, and that you give credit to the author (James Tonn).π'I hope this code will help you in your programming.π'   -Jimmy Tonn 8/94π'   [e-mail]π'   [e-mail]π'   [e-mail]π'   [e-mail]ππDEFINT A-Z  'declare all variables starting with a through z as integersπSCREEN 13   'set screen mode 13, 320x200x256πCLS         'clear screenππRESTORE world   'restore data pointer so all data reading starts after labelπ                ' "world"ππCONST ACROSS = 11 'this is the number of across tiles that will appear onπ                  'the screen at a time, the total number of across tilesπ                  'is stored in the variable tacrossπCONST DOWN = 11   'number of down tiles on screen... total down tiles areπ                  'stored in tdownππDIM blankimg(116) 'create an array for the blank tileπ                  'this tile will be totally black, all zero'sπDIM grassimg(116) 'create an array for the grass tile's image, 116 bytesπDIM treeimg(116)  'create an array for the tree tile's image, 116 bytesπDIM playerimg(116)'create as array for the player tile's image, 116 bytesππREAD tacross, tdown  'get these values from the big data block "world"π                     'at the end of this programππTYPE tiletype          'create a type called tiletypeπ    x AS INTEGER       'the tile's x pixel coordπ    y AS INTEGER       'the tile's y pixel coordπ    style AS INTEGER   'the tile's styleπEND TYPEππDIM tile(tacross, tdown) AS tiletype 'declare array "tile" as tiletypeππTYPE playertype  'create a type called playertypeπ    x AS INTEGER 'x tile where the player isπ    y AS INTEGER 'y tile where the player isπ    px AS INTEGER 'the players "permanant" x tile, the tile that he appearsπ                  'in out of the tiles on the screenπ    py AS INTEGER 'the players "permanant" y tileπEND TYPEππDIM player AS playertype 'declare the variable player as a playertypeππREAD player.x, player.y  'read player x and y coords from data block "world"πplayer.px = 6πplayer.py = 6ππDEF FNSetlocs    'function to set pixel locs of tiles that appear on screenπ   FOR a = 1 TO ACROSSπ      FOR d = 1 TO DOWNπ         tile(a, d).x = 15 * a  'set pixel x location of tileπ         tile(a, d).y = 15 * d  'set pixel y location of tileπ      NEXT d                    '(all tiles are 15x15 pixels)π   NEXT aπEND DEFππDEF FNSetAtts   'function to read the styles of all tiles from data blockπ   FOR d = 1 TO tdownπ      FOR a = 1 TO tacrossπ         READ tile(a, d).style 'read the tile's styleπ      NEXT aπ   NEXT dπEND DEFπππ'this next routine draws the tile on the screenπ'the tx and ty variables are the tile numbers out of all the tilesπ'the cx and cy variables are locations of the tile spaces where the tilesπ'will be displayed on the screenπDEF FNDrawTile (tx, ty, cx, cy)π    SELECT CASE tile(tx, ty).style  'check the tile's styleπ          CASE 0  'if it's 0, draw an array of zero's (a black tile)π              PUT (tile(cx, cy).x, tile(cx, cy).y), blankimg, PSETπ          CASE 1  'if it's 1, draw the grass tileπ              PUT (tile(cx, cy).x, tile(cx, cy).y), grassimg, PSETπ          CASE 2  'if it's 2, draw the tree tileπ              PUT (tile(cx, cy).x, tile(cx, cy).y), treeimg, PSETπ    END SELECTπEND DEFππ'this draws all the visible tiles on the screenπ'it will draw from 5 tiles to the left of the player to 5 tiles to his rightπ'and from 5 tiles up to 5 tiles downπDEF FNDrawScreenπ   FOR rela = -5 TO 5π      FOR reld = -5 TO 5π           dummy = FNDrawTile(player.x + rela, player.y + reld, player.px + rela, player.py + reld)π      NEXT reldπ   NEXT relaπEND DEFππ'this function draws the player on the screen in his "permanant" locationπDEF FNDrawPlayerπ   PUT (tile(player.px, player.py).x, tile(player.px, player.py).y), playerimg, PSETπEND DEFππDEF FNDisplayImg 'this function will read an images colors from a data blockπ                 'and display the image on the screen. Before calling thisπ                 'function, reset the data pointer to the beginning of theπ                 'data block for the image.π   FOR dp = 1 TO 15π      FOR ap = 1 TO 15π         READ att                     'read the value at the point in the data blockπ         PSET (ap + 10, dp + 10), att 'put the pixel on the screen with theπ                                      'color that was read from the dataπ                                      'blockπ      NEXT apπ   NEXT dpπEND DEFππ'* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *π' * * * * * * * * * * * * End of Function Defs* * * * * * * * * * * * * *ππdummy = FNSetlocs   'set the locations for the on-screen tilesπdummy = FNSetAtts   'set the styles for all the tilesππGET (11, 11)-(25, 25), blankimg 'get an array that is all zero's, which willπ                                'the black tile that we put around the edgesπ                                'of the map. No data reading is needed sinceπ                                'the screen is already totally black. Allπ                                'we need to do is grab a block.ππRESTORE grassdata   'restore the data pointer to the beginning of the dataπ                    'block that stores the grass tile's image. If you'reπ                    'reseting the data pointer to load the images, do itπ                    'after calling FNSetLocs and FNSetAtts, because theyπ                    'need the data pointer in a certain placeπdummy = FNDisplayImg  'call routine to read and display the imageπGET (11, 11)-(25, 25), grassimg 'get the image into array "grassimg"πPUT (11, 11), grassimg, XOR     'put image over existing one to clear itππRESTORE treedata 'restore data pointer to beginning of the tree tile's imageπdummy = FNDisplayImg 'read and display the imageπGET (11, 11)-(25, 25), treeimg  'get the image into array "treeimg"πPUT (11, 11), treeimg, XOR  'put image on top of the old one to clear itππRESTORE playerdata 'restore pointer to beginning of player tile's imageπdummy = FNDisplayImg 'read and display the imageπGET (11, 11)-(25, 25), playerimg  'get the image into array "playerimg"πPUT (11, 11), playerimg, XOR  'put image on top of the old one to clear itππdummy = FNDrawScreen  'draw the screen onceπdummy = FNDrawPlayer  'draw the player onceπππDOπ  kbd$ = INKEY$            'get a "transparent" inputπ  IF kbd$ <> "" THEN       'if there actually was a user input, then...π    kbd$ = RIGHT$(kbd$, 1) 'get the first byte of the input (this is neededπ                           'if you want to look for input from the cursorπ                           'keys)π    SELECT CASE kbd$π          CASE CHR$(27)    'user pressed escape keyπ              END          'end the programπ          CASE CHR$(72) 'user pressed up arrowπ              IF tile(player.x, player.y - 1).style <> 2 THENπ              '^^^ check if the tile the player is about to move into isπ              'already occupied by a tree.π              'if you check for a tree, you really don't need to check ifπ              'the player is going to go past the line of trees at theπ              'edge with the other method, because if you check for a tree,π              'it will stop you before you go past the line anyway I justπ              'added them both in case the reader wanted to use a certainπ              'method for some reason.π               π                IF player.y - 1 > 5 THEN     'make sure he doesn't go pastπ                                             'the line of trees. You willπ                                             'probably have to change thisπ                                             'number around if you change theπ                                             'player's view screen sizeπ                  player.y = player.y - 1    'decrease player y tile by oneπ                END IFπ                dummy = FNDrawScreen       'draw the screenπ                dummy = FNDrawPlayer       'put the player on the screenπ              END IFπ          CASE CHR$(80) 'user pressed down arrowπ              IF tile(player.x, player.y + 1).style <> 2 THENπ              '^^^ check if the tile the player is about to move into isπ              'already occupied by a tree.π                IF player.y + 1 < (tdown - 5) THEN 'keep player on screenπ                  player.y = player.y + 1    'increase player y tile by oneπ                END IFπ                dummy = FNDrawScreen       'draw the screenπ                dummy = FNDrawPlayer       'put the player on the screenπ              END IFπ          CASE CHR$(75) 'user pressed left arrowπ              IF tile(player.x - 1, player.y).style <> 2 THENπ              '^^^ check if the tile the player is about to move into isπ              'already occupied by a tree.ππ                IF player.x - 1 > 5 THEN   'keep player on screenπ                  player.x = player.x - 1    'decrease player x tile by oneπ                END IFπ                dummy = FNDrawScreen       'draw the screenπ                dummy = FNDrawPlayer       'put the player on the screenπ              END IFπ          CASE CHR$(77) 'user pressed right arrowπ              IF tile(player.x + 1, player.y).style <> 2 THENπ              '^^^ check if the tile the player is about to move into isπ              'already occupied by a tree.ππ                IF player.x < (tacross - 6) THEN  'keep player on screenπ                  player.x = player.x + 1    'increase player x tile by oneπ                END IFπ                dummy = FNDrawScreen       'draw the screenπ                dummy = FNDrawPlayer       'put the player on the screenπ              END IFπ    END SELECTπ  END IFπLOOP        'restart the main loopπππworld:ππDATA 30,30πDATA 15,15πDATA 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0πDATA 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0πDATA 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0πDATA 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0πDATA 0,0,0,0,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,0,0,0,0,0πDATA 0,0,0,0,2,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,2,0,0,0,0,0πDATA 0,0,0,0,2,2,1,1,1,1,1,1,1,1,1,2,1,1,1,1,1,1,1,1,2,0,0,0,0,0πDATA 0,0,0,0,2,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,2,0,0,0,0,0πDATA 0,0,0,0,2,1,1,1,1,1,1,1,1,1,1,1,1,1,1,2,1,1,1,1,2,0,0,0,0,0πDATA 0,0,0,0,2,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,2,0,0,0,0,0πDATA 0,0,0,0,2,1,1,1,1,2,1,1,1,1,1,2,1,1,1,1,1,2,1,1,2,0,0,0,0,0πDATA 0,0,0,0,2,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,2,0,0,0,0,0πDATA 0,0,0,0,2,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,2,0,0,0,0,0πDATA 0,0,0,0,2,2,1,1,1,1,1,2,1,1,1,1,1,1,2,1,1,1,1,2,2,0,0,0,0,0πDATA 0,0,0,0,2,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,2,0,0,0,0,0πDATA 0,0,0,0,2,1,1,1,1,1,1,1,1,1,2,1,1,1,1,1,2,1,1,1,2,0,0,0,0,0πDATA 0,0,0,0,2,1,1,2,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,2,0,0,0,0,0πDATA 0,0,0,0,2,1,1,1,1,1,1,1,1,2,1,1,1,1,1,1,1,1,1,1,2,0,0,0,0,0πDATA 0,0,0,0,2,2,1,1,1,1,1,1,1,1,1,1,1,2,1,1,1,2,1,1,2,0,0,0,0,0πDATA 0,0,0,0,2,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,2,0,0,0,0,0πDATA 0,0,0,0,2,1,1,1,1,1,1,1,1,1,1,1,2,1,1,1,1,1,1,1,2,0,0,0,0,0πDATA 0,0,0,0,2,1,1,1,1,1,1,2,1,1,1,1,1,1,1,1,1,1,1,1,2,0,0,0,0,0πDATA 0,0,0,0,2,1,2,1,1,1,1,1,1,1,1,2,1,1,2,1,1,1,2,1,2,0,0,0,0,0πDATA 0,0,0,0,2,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,2,0,0,0,0,0πDATA 0,0,0,0,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,0,0,0,0,0πDATA 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0πDATA 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0πDATA 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0πDATA 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0πDATA 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0ππgrassdata:πDATA 0,0,0,0,2,0,0,0,148,0,0,2,0,0,0πDATA 0,2,0,0,0,0,0,0,0,0,0,0,0,0,141πDATA 0,0,0,0,142,0,0,2,0,0,0,0,0,0,0πDATA 0,0,0,0,0,0,0,0,0,0,0,0,2,0,0πDATA 0,2,0,2,0,145,0,0,0,142,0,0,0,0,0πDATA 0,0,0,0,0,0,0,0,2,0,0,0,0,0,2πDATA 0,0,0,142,0,0,0,0,0,0,0,2,0,0,0πDATA 0,2,0,0,0,142,0,0,0,0,0,0,0,0,0πDATA 0,0,0,0,0,0,0,0,0,2,0,0,147,0,0πDATA 0,142,0,0,0,0,0,0,0,0,0,0,0,0,0πDATA 0,0,0,2,0,0,142,0,0,2,0,0,0,2,0πDATA 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0πDATA 2,0,0,0,0,145,0,2,0,0,0,0,2,0,0πDATA 0,0,0,2,0,0,0,0,0,0,0,0,0,0,142πDATA 145,0,0,0,147,0,0,0,2,0,0,2,0,0,0ππtreedata:πDATA 0,0,0,2,2,2,2,2,2,2,2,0,0,0,0πDATA 0,0,2,2,2,2,2,2,2,2,2,2,0,0,0πDATA 0,6,2,2,2,2,2,2,2,2,2,6,0,0,0πDATA 0,2,6,2,2,2,2,2,2,2,6,2,0,0,0πDATA 0,2,2,6,2,2,2,2,2,6,2,2,0,0,0πDATA 0,0,2,2,6,2,2,2,6,2,2,0,0,0,0πDATA 0,0,0,0,0,6,6,6,0,0,0,0,0,0,0πDATA 0,0,0,0,0,6,6,6,0,0,0,0,0,0,0πDATA 0,0,0,0,0,6,6,6,0,0,0,0,0,0,0πDATA 0,0,0,0,0,6,6,6,0,0,0,0,0,0,0πDATA 0,0,0,0,0,6,6,6,0,0,0,0,0,0,0πDATA 0,0,0,0,0,6,6,6,0,0,0,0,0,0,0πDATA 0,0,0,0,0,6,6,6,0,0,0,0,0,0,0πDATA 0,0,0,0,6,6,6,6,6,0,0,0,0,0,0πDATA 0,0,0,6,6,6,6,6,6,6,0,0,0,0,0ππplayerdata:πDATA 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0πDATA 0,0,0,0,0,0,7,7,7,0,0,0,1,0,0πDATA 0,0,0,0,0,0,7,7,7,0,0,0,1,0,0πDATA 0,0,0,0,0,0,7,7,7,0,0,0,1,0,0πDATA 0,0,0,0,0,0,0,7,0,0,0,0,1,0,0πDATA 0,0,0,0,0,0,0,7,0,0,0,0,1,0,0πDATA 0,2,0,2,0,0,0,7,0,0,0,1,1,1,0πDATA 0,2,2,7,7,7,7,7,7,7,7,7,7,0,0πDATA 0,2,2,2,0,0,0,7,0,0,0,0,1,0,0πDATA 0,0,2,0,0,0,0,7,0,0,0,0,1,0,0πDATA 0,0,0,0,0,0,0,7,0,0,0,0,0,0,0πDATA 0,0,0,0,0,0,7,0,7,0,0,0,0,0,0πDATA 0,0,0,0,0,7,0,0,0,7,0,0,0,0,0πDATA 0,0,0,0,7,0,0,0,0,0,7,0,0,0,0πDATA 0,0,0,7,0,0,0,0,0,0,0,7,0,0,0ππMichael J. Kelly               SMALL FONT (8X8 SANS SERIF)    QBTIPS_?.DOC                   07-06-92 (08:03)       QB, PDS                52   3395     SMLFONT.BAS DEFINT A-Z:DIM SHARED K,S,B&,Z&:V1 'Created by PostIt! 7.2πSUB V1:OPEN "O",1,"SMLFONT.ZIP",4^6:Z&=2268:?STRING$(50,177);πU"%up()%9%%%R-%KEAaEsZ%dmc)%%%%-%%%0%%%%xr%qkts%ySks[yrzF,9]k5%SAπU"uSZ;o*08U=;c[e8h%MRgPL;V+oI&?uS2QjB8WQK/>H%*deSDHUQWL1CA7K5\2gqπU"0gLqf+=n5gGW%7XO.O*BsNzD5DvDzSX71jpd=WX]W]\%tVN\Y:q[*NY]b17[)<rπU":P[_G3.YiyQ+:JUa''EduP(8L*SfY%=ZX88,.2l.D]v;g)V4,PthA9H3ZMs[HMFπU"DMDtMwL736L&cUceh=i(F,ePEPC?i1WZ<1(7Do92wN1XyLNI6vd;[Pr>H0mq6%qπU"<ckAfJ;5Ht2W.]BUwHEPpm&*KXQV/<()Ix4fn#10jB54#CjK'<l&OsB7=H-V^6fπU"FVT-[hoKA,t:(tTNSO\ZayAy:^tVzyKY0iMK8cN^uOT%up)OtCHPNs&2io+AKfRπU"ZZw=6t+>m_.7+InHv:ZCc&j]5?$t.DLmx;9tQl2SdzTJ6Ya((<DJ7>T4Q0qNtZvπU"1OPengi#\>/%q[%6lhX=0Z&>rI+D6LMT$##Xc5Za4-Y64B-e0BLtA=&%cXN0kQ+πU"Fbk2QAc&TQDWS3&kL^a%x9\Ub78NcRW&<)k6^[l?sg7G:76iTp^8:a3Zl(l#5W1πU"/^H=/??pj.-s5N/N\X:\*^qI[,a&=QP#iHEpe%u,_w6-8<;onym)r_5tR8i9]lvπU"^1c>j]IP]PL;Y$x3IhU1-$t[<pF,m\lSl>H[?=)-&I,/]oFRE(p;kinJJc#jxC4πU"eKf6Zv.xj:n9SK5:a'lQ&8jR1kSw$eqVMYTt=2%\$%.BSZdIVNqJi:66LIs/x\WπU".Q)aAb-;^iEnn[-:#O9s/p(]_Y$mw,0aO,j6=)T_2lq4S.ICV$<]J>*]29&dQ4LπU"tE.j,[Q/kW+Orj7u$oOUDDU\ceU9V-.RYNlLd.JTP)gm5h1<gG==pF.hk;2bnolπU"NECbFRPzko4><OAS96#vLy0MKc'ob1l/$]eXgqHNcixAGpyxM<9>a>z+IxI&jfiπU"w8Ih0SO]O.DtUroKgp*PFL2W?K]Npy4H+I7Bla'0P&kKQmOKZ-GLlolV(*KWG'oπU",c^\c%jjmufh\nr<n\.rw4v=b^s'3<m5ub'Y*4#_YQLw=p?u.W)iafG[#DN#V;bπU"xj)3sx+iqo2#xxqKn#=m-bm1LBS^XJNVuf+:8xls8_\I+stcOH=nnfq5<GK/[aIπU"8KrP0+f1;'YV8rj^a]o,dD-gc[IM-]h9<'D2.iaDY^:LvQ8\TI6x=$I&;fGYBkLπU"iYPTmI>+_dW'QER2VVV0EEFeRWZN2$HleZfkZgt%7v7Uzf?apx.yHDib=6k6S3^πU"\yr>?hSGyYG2WYhE&<s,maJnVlJ6w(/WEnC]j'6;'Am5F51P$2ft[3luLLI2Kc-πU"$rlxcG&>x&7<uM#zoJO=c<xu%p()9%%%%-I%rFaXE*[s-G?(%%%I.%%%/%%%%xrπU"q%ksyS[gfx&e%rB[7]56x<>NaG'R.y^s)k.EA04+3*;[V98EwBvQ/^oYQ8?a6l;πU"8..\[..WXqfOAs%Ucp6m3.p]^X%i.[1QQ,39*uoqvkY(*7?gTA02Te_J(8RooRzπU")SS.fJn:q/#yW&Au<S&,#MpJcVQT)0X*d0*dO+zK_^H%L(Qpa*&N00Ce;MZZn*DπU"7,a]W?iu$>f>]Ppq/7X?;TIS\?0#P^nQ171mWrAAB,Z-Vkm\%)/oFQ0^Jb;0%aAπU"zw4u:0B#HXX+?g'X50?)108[^d].W2O<Wj(VL;D6l=#CC$Y66^/'?o\;oK/o2KYπU"W2^0mo/%94S:DpD4(5UWn4bN\Uf9dKeo6L:';9>3b*]nQBEPRjeDAh:mfCdT8,oπU"lUX:$wc1aib0BA4N>;Q,+OWcwE/')mqW2mO<YL9H>A11gucL_7,wf[)Mrfb=4/XπU">=2=K#84Ku4pW8fSABMY+1aQKuc0SK;%C[4kto5iJek]fu((oD$=En.9cc2Cn(yπU"&'O[(i<2xvh'sNCNkC$PTFNPr:rdK$VZ*7yZ8+q;tC0+17m&BzEi,y)8bGq[%NtπU"29a1+PcX'eNPh1R-[-O;=kv'>nDW&6kOOf.HWpT(q(xU?Qi$26;iw+pVr>7I/Q7πU">bE,XsGSB2R-Jd-UKh\5m3:cZaDu*5(Q;]UvZHfOARjAaW^I]wRWpxaOr.+<U5(πU"VJ]SUL<Em0((a9>55JV+N><He2hE&(Lh(ksoI.em$mw*h_l4N$2X]lv9pMW2vVpπU"=CT<njkYC7E9PdkWt^K,4nL_;aF_G=FwIFYQ+OS')B*tkpz[4)r&t\nOR#zyF>HπU"BBWvsDx)/gPvbddNBu,L'6?-3NwUthOz-T>GA\IOeA(gDptm-[5O.bH-re8%EZlπU"1^:/pXx?a&uA/vX:pbzX7l^=#]A1iSKXhEcD8$'PD7\Va%GF?.6NTCig9JUgRwEπU",<%5-xFK7g346Y70'5&Ytupk_/;&Bq:$#wn)f[=r[l0l09R=Jr#+;5MchszX;2YπU"wXkPJiweefvS#)dvoopgB1UCVD,Jdbqw5U,Bfah(&mo=cK%Wb]PTOGqTFx4D,LRπU"1^]Q^&lCHdo>CUaNCkPP>3sd2d$V<tIR4URt2#(ws\#(GK:z<y/IHA;riW,[Ml2πU"RNG3I+\\F+ff*INRvbn's$jXB%:p=c27/[E0n2%;F\-sv=TqXNv?sVR6:TIyXWDπU"Qu'c&.a'W#XTC5c_g5u%2up&%'9%9%%%%-O%KEa.EsZd%mc)%%%%-%%%0%%%%%%πU"%%%%%E%%%%%%%%%x%rqkt%sySk%syup%&'9%%9%%%#-%rFnaE*[>sG?(%%%I.%%πU"%/%%%%%%%%%&%%E%%%&6)%%%xrqk%sySg%fxup%*+%%%%%'%.'%#%%%%z-%%%%%πEND SUBπCLOSE:IF S=59AND B&=Z&THEN?" :) Ok!"ELSE?" :( Bad!πSUB U(A$):FOR A=1TO LEN(A$):C=ASC(MID$(A$,A))-37:IF C<0THEN C=91+C*32πIF K<4THEN K=C+243ELSE?#1,CHR$(C+(K MOD 3)*86);:K=K\3:B&=B&+1πS=(S+C)AND 255:NEXT:LOCATE,1:?STRING$(B&*50\Z&,219);:END SUBπEarl L. Montgomery             VESA MANDELBROT                FidoNet QUIK_BAS Echo          04-17-96 (22:32)       QB, PDS                135  4270     VESABROT.BAS' Here is a VESA high resolution Mandelbrot program. It allowsπ' you to choose the mode. You can let the computer pick the values orπ' you can enter them yourself. For testing I recommend you select <N>π' when prompted and enter the following yourself:ππ' acorner -.114π' bcorner -.917π' side .017ππ' On my 486/50 it takes about 12 minutes to complete. I think it looksπ' like multiple tornado funnels with multiple lightning strikes.ππ' BTW this is if you choose #1. 640x400x256ππ' When the screen is filled you will hear a beep and you can exit orπ' run it again by pressing the space bar twice. Or if you have the TSRπ' GRABBER that can be found on most BBSs you can save the screenπ' to an executable file by pressing CNTRL= then <ENTER>. When youπ' exit to dos you can view the saved screen by simply typingπ' SCREEN00 at the DOS prompt. The loading takes less than a sec!ππ' To run this program you must have a VESA compatiable graphicπ' card/chip <SVGA>. Or if your SVGA card/chip is not VESAπ' compatiable you can run it provided you have a VESA TSR loaded.ππ' P.S. If you let the computer pick the values or even if you enter theπ' values and nothing appealing is being put on the screen you canπ' press the space bar and you will be prompted to EXIT or RUNπ' again.ππ' Let me know if you have problems. Enjoy!ππ '$INCLUDE: 'qb.bi'π DIM inreg AS RegTypeπ DIM outreg AS RegTypeπ DEFDBL A-Zπ RANDOMIZE TIMERπ KEY(10) ONπ ON KEY(10) GOSUB endofprogramπ CLS : LOCATE 12, 30: COLOR 14: PRINT "WELCOME TO VESABROT"π LOCATE 14, 23: PRINT "Brought to you by Earl Montgomery"π SLEEP (2)πmakeselection:π CLSπ LOCATE 1, 1π PRINT "1. 640x400x256"π PRINT "2. 640x480x256"π PRINT "3. 800x600x256"π PRINT "4. 1024x768X16"π PRINT "5. 1024x768x256"π PRINT : INPUT "Select mode"; m%π IF m% < 1 OR m% > 5 THEN BEEP: GOTO makeselectionπ CLSπ INPUT "Let the computer select values <Y/N>"; q$π q$ = UCASE$(q$)π IF q$ = "Y" THEN CLS : GOTO randomselectπ INPUT "Acorner "; aπ acorner = aπ INPUT "Bcorner "; bπ bcorner = bπ INPUT "Side "; sπ side = sπ GOTO startπrandomselect:π acorner = (RND * 5 - 2)π IF acorner > 2 THEN GOTO randomselectπ IF acorner < -2 THEN GOTO randomselectπbcornerselect:π bcorner = (RND * 5 - 2)π IF bcorner > 2 THEN GOTO bcornerselectπ IF bcorner < -2 THEN GOTO bcornerselectπsideselect:π side = (RND * 5 - 2)π IF side > 2 THEN GOTO sideselectπ IF side < -2 THEN GOTO sideselectπstart:π maxdwell = 150π inreg.ax = &H4F02π IF m% = 1 THEN inreg.bx = &H100π IF m% = 2 THEN inreg.bx = &H101π IF m% = 3 THEN inreg.bx = &H103π IF m% = 4 THEN inreg.bx = &H104π IF m% = 5 THEN inreg.bx = &H105π CALL interrupt(&H10, inreg, outreg)π IF m% = 4 THEN numcolors = 16:  ELSE numcolors = 256π IF m% = 1 THEN numrows = 399π IF m% = 2 THEN numrows = 479π IF m% = 3 THEN numrows = 599π IF m% = 4 OR m% = 5 THEN numrows = 767π IF m% = 1 OR m% = 2 THEN numcols = 639π IF m% = 3 THEN numcols = 799π IF m% = 4 OR m% = 5 THEN numcols = 1023π yoffset = 1: xoffset = 1π highdwell = 0π gap = side / numrowsπ ac = acornerπ FOR x = xoffset TO numcols - 1 + xoffsetπ ac = ac + gap: bc = bcornerπ FOR y = yoffset TO numrows - 1 + xoffsetπ bc = bc + gapπ az = 0: bz = 0: count% = 0: size = 0π WHILE (size < 4) AND (count% < maxdwell)π temp = az * az - bz * bz + acπ bz = 2 * az * bz + bcπ az = temp: size = az * az + bz * bzπ count% = count% + 1π WENDπ IF (count% < maxdwell) AND (count% > highdwell) THEN highdwell = count%π IF count% <> maxdwell THEN GOSUB setpixelcolorπ i$ = INKEY$π IF i$ = CHR$(32) THEN GOTO restartπ NEXT: NEXTπ BEEPπwait1:π i$ = INKEY$π IF i$ = CHR$(32) THEN GOTO endofprogram:  ELSE GOTO wait1πsetpixelcolor:π c = count% MOD (numcolors - 1) + 1π cc = &HC00 + c: z = numrows - y + 1π inreg.ax = cc: inreg.bx = 0: inreg.cx = x: inreg.dx = zπ CALL interrupt(&H10, inreg, outreg)π RETURNπendofprogram:π SLEEP (500)π inreg.ax = &H3: CALL interrupt(&H10, inreg, outreg)π CLS : LOCATE 1, 1π INPUT "[R]un again or [E]xit to DOS"; q$π q$ = UCASE$(q$)π IF q$ = "R" THEN RUNπ CLS : LOCATE 14, 23: PRINT "Make sure you rename any saved files!"π SLEEP (2): SCREEN 0: CLS : ENDπrestart:π inreg.ax = &H3π CALL interrupt(&H10, inreg, outreg)π RUNπJoshua Dickerson               SPRITE(BITMAP) EDITOR          FidoNet QUIK_BAS Echo          04-23-96 (21:25)       QB, QBasic, PDS        124  2973     BITMAP.BAS  '    Here is a simple bitmap editor i wrote to aid in the design of my games..π'You start out in zoom mode where you can edit individual pixils of yourπ'bitmap, and as soon as you press esc, it automaticly writes a qBasic file withπ'data statements and a loader for them..use the numeric keypad to move aroundπ'and the , and . to select the colors (Actually < > without the shift hehπ'heh).. hit space to set the point to the current color.. An "X" will denoteπ'where you are, but you will not see the changes to that pixil until you moveπ'the cursor away from the spot you were working on.ππDECLARE SUB UpdateScrollBar ()πDECLARE SUB Display ()ππDIM SHARED x, y, xMax, yMax, SelectedColorππCLSπINPUT "Bitmap X size ->", xMaxπINPUT "Bitmap Y size ->", yMaxππDIM SHARED Bmp(xMax, yMax) AS STRING * 1πSCREEN 13ππLOCATE 23, 1πPRINT "v"πUpdateScrollBarπDisplayπDO WHILE a$ <> CHR$(27)π   SELECT CASE a$π      CASE ","π         SelectedColor = SelectedColor - 1π         IF SelectedColor < 0 THEN SelectedColor = 255π         UpdateScrollBarπ      CASE "."π         SelectedColor = SelectedColor + 1π         IF SelectedColor > 255 THEN SelectedColor = 0π         UpdateScrollBarπ      CASE " "π         Bmp(x, y) = CHR$(SelectedColor)π         Displayπ      CASE "4"π         IF x > 0 THEN x = x - 1π         Displayπ      CASE "6"π         IF x < xMax THEN x = x + 1π         Displayπ      CASE "8"π         IF y > 0 THEN y = y - 1π         Displayπ      CASE "2"π         IF y < yMax THEN y = y + 1π         Displayπ   END SELECTππ   LOCATE 7, 7π   COLOR SelectedColorπ   PRINT "X";π π   a$ = INPUT$(1)πLOOPππCLSπFOR i = 0 TO xMaxπ   FOR j = 0 TO yMaxπ      PSET (i, j), ASC(Bmp(i, j))π   NEXTπNEXTππSize% = 4 + INT(((xMax + 1) / 2) * (yMax + 1))πDIM BitMap%(Size%)ππGET (0, 0)-(xMax, yMax), BitMap%ππOPEN "Test.bas" FOR OUTPUT AS #1πPRINT #1, "SCREEN 13"πPRINT #1, "DIM BitMap%("; Size%; ")"πPRINT #1, "FOR I = 0 to"; Size%πPRINT #1, "   READ BitMap%(I)"πPRINT #1, "NEXT"πPRINT #1, ""πPRINT #1, "PUT (0,0), BitMap%"πPRINT #1, "END"πPRINT #1, ""πPRINT #1, "DATA ";ππFOR i = 0 TO Size% - 1π   x = x + 1π  π   PRINT #1, "&H" + HEX$(BitMap%(i));π   IF x > 8 THENπ      x = 0π      PRINT #1, ""π      PRINT #1, "DATA ";π   ELSEπ      PRINT #1, ", ";π   END IFπ   πNEXTπPRINT #1, "&H" + HEX$(BitMap%(Size%))ππCLOSEππSUB Displayπ   CONST WindowSize = 6ππ   FOR i = -WindowSize TO WindowSizeπ      LOCATE WindowSize + 1 + i, 1π      FOR j = -WindowSize TO WindowSizeπ         IF j + x >= 0 AND i + y >= 0 AND j + x <= xMax AND i + y <= yMax THENπ            COLOR ASC(Bmp(j + x, i + y))π            PRINT CHR$(219);π         ELSEπ            COLOR 15π            PRINT CHR$(178);π         END IFπ      NEXTπ   NEXTπEND SUBππSUB UpdateScrollBarπ   LOCATE 24, 1π   FOR i = 0 TO 39π      COLOR (i + SelectedColor) MOD 255π      PRINT CHR$(219);π   NEXTπEND SUBπTyler Barnes                   MONITOR INTERRUPTS             FidoNet QUIK_BAS Echo          04-15-96 (02:22)       QB, PDS                88   2710     TRAPINT.BAS 'Well, this code may be kind of useless, but it's something that I was messingπ'with, and decided to post. I don't really have a use for it, maybe someoneπ'else does... It could probably be written better as well. You can see I don'tπ'have a high opinion on this code. <G>π'It allows you to monitor interrupts... Sort of pseudo-trapping.ππDECLARE FUNCTION CalledInterrupt% (intnum%)πDECLARE SUB TrapInterrupt (intnum%, ExitProc%)πDECLARE SUB RestoreInterrupt (intnum%)π'$INCLUDE: 'qb.bi'πDIM SHARED InregX AS RegTypeX, OutregX AS RegTypeXπDIM IntSegs(0 TO 255) AS INTEGER, IntOffs(0 TO 255) AS INTEGERπDIM IntCode(0 TO 255) AS STRING * 25π πCONST Abort = 0, Continue = 1, All = -1π π'Pseudo interrupt trapperπ'Future enhancements: Decrease memory used?π'                     Return Registersπ π πTrapInterrupt 5, AbortπDOπLOOP UNTIL CalledInterrupt(5)πRestoreInterrupt AllππDEFINT A-ZπFUNCTION CalledInterrupt (intnum%)πSHARED Interrupts AS STRING * 256πIF MID$(Interrupts, intnum% + 1, 1) = CHR$(2) THENπMID$(Interrupts, intnum% + 1, 1) = CHR$(1)πCalledInterrupt = -1πELSEπCalledInterrupt = 0πEND IFπEND FUNCTIONππSUB RestoreInterrupt (intnum)πSHARED Interrupts AS STRING * 256, IntSegs() AS INTEGER, IntOffs() AS INTEGERπIF intnum < 0 THENπFOR I% = 1 TO 256πIF MID$(Interrupts, I%, 1) <> CHR$(0) THENπInregX.Ax = &H2500 + (I% - 1)πInregX.DS = IntSegs(I% - 1)πInregX.Dx = IntOffs(I% - 1)πCALL INTERRUPTX(&H21, InregX, OutregX)πEND IFπNEXT I%πELSEπInregX.Ax = &H2500 + intnumπInregX.DS = IntSegs(intnum)πInregX.Dx = IntOffs(intnum)πCALL INTERRUPTX(&H21, InregX, OutregX)πEND IFπEND SUBππSUB TrapInterrupt (intnum, ExitProc)πSHARED IntCode() AS STRING * 25, Interrupts AS STRING * 256πSHARED IntSegs() AS INTEGER, IntOffs() AS INTEGERπSTATIC FirstTimeπIF FirstTime = 0 THENπFirstTime = 1πFOR I% = 0 TO 255πMID$(Interrupts, I% + 1, 1) = CHR$(0)πNEXT I%πEND IFπInregX.Ax = &H3500 + intnumπCALL INTERRUPTX(&H21, InregX, OutregX)πIntSegs(intnum) = OutregX.ESπIntOffs(intnum) = OutregX.BxπMID$(Interrupts, intnum + 1) = CHR$(1)πIC$ = CHR$(6) + CHR$(&H55) + CHR$(&H50) + CHR$(&HB8)πIC$ = IC$ + MKI$(VARSEG(Interrupts))πIC$ = IC$ + CHR$(&H8E) + CHR$(&HC0) + CHR$(&HBD) + MKI$(VARPTR(Interrupts) + intnum)πIC$ = IC$ + CHR$(&HB0) + CHR$(2) + CHR$(&H26) + CHR$(&H88) + CHR$(&H46)πIC$ = IC$ + CHR$(0) + CHR$(&H58) + CHR$(&H5D) + CHR$(7)πIF ExitProc = 0 THENπIC$ = IC$ + CHR$(&HCF)πELSEπIC$ = IC$ + CHR$(&HEA) + MKI$(IntOffs(intnum)) + MKI$(IntSegs(intnum))πEND IFπIntCode(intnum) = IC$πInregX.Ax = &H2500 + intnumπInregX.DS = VARSEG(IntCode(intnum))πInregX.Dx = VARPTR(IntCode(intnum))πCALL INTERRUPTX(&H21, InregX, OutregX)πEND SUBππEric Carr                      SIMULTANEOUS KEY DEMO          FidoNet QUIK_BAS Echo          03-18-96 (13:12)       QB, QBasic, PDS        70   3011     KEYINPUT.BAS'Ok..Here is the sample keyboard routine I promised..I haven't tested it on anyπ'other computer excpet mine, but it should work for anyone..  This program letsπ'you move a box around by pressing the arrow keys..The acual routine in only 4π'lines as i have marked..This program requires a minimum of a 486sx 25mhz ifπ'not compiled to run fast enough for all the keys to be updated..I alsoπ'reprogrammed the internal timer from 18.2 to 30, so I could time it to 30 fps.π'To see if a key is being currently pressed, the variable KS is used (IFπ'KS(75)=1 THEN button is pressed). Instead of ASCII, this uses scan codes,π'which you can look at in the QB help..Hope you can understand it! :)ππ DEFINT A-Z: DIM B(300): CLSππ N& = 39772                  'Reprogram the timer to 30hzπ LB& = N& AND &HFF           'instead of 18.2 (for 30 framesπ HB& = (N& / 256) AND &HFF   'per second.)π OUT &H43, &H3C: OUT &H40, LB&: OUT &H40, HB&ππ DIM KS(255), SC(255), DU(255)π FOR E = 0 TO 127      ' Setup key data table KSC()π SC(E) = E: DU(E) = 1π NEXTπ FOR E = 128 TO 255π SC(E) = E - 128: DU(E) = 0π NEXTππ SCREEN 13: COLOR 4π LOCATE 10, 3: PRINT "Keyboard input routine by Eric Carr"π COLOR 7: PRINT : COLOR 2π PRINT "  Use the arrow keys to move the box."π PRINT "Note that you can press two or more keys"π PRINT "    at once for diagnal movement!"π PRINT : COLOR 8: PRINT "          Press [Esc] to quit"π X = 150: Y = 100: BX = X: BY = Yπ DEF SEG = 0π POKE (1132), 0π GET (X, Y)-(X + 15, Y + 15), Bπ DO  'main loopπT:π I$ = INKEY$       ' So the keyb buffer don't get full     \routine/π I = INP(&H60)     ' Get keyboard scan code from port 60h   \lines/π OUT &H61, INP(&H61) OR &H82: OUT &H20, &H20       '         \!!!/π KS(SC(I)) = DU(I) ' This says what keys are pressed          \!/π π IF PEEK(1132) < 1 THEN GOTO T  'If not enough time was passed goto Tπ POKE (1132), 0  'reset timer againπ BX = X: BY = Yπ IF KS(75) = 1 THEN XC = XC - 2: IF XC < -15 THEN XC = -15π IF KS(77) = 1 THEN XC = XC + 2: IF XC > 15 THEN XC = 15π IF KS(72) = 1 THEN YC = YC - 2: IF YC < -15 THEN YC = -15π IF KS(80) = 1 THEN YC = YC + 2: IF YC > 15 THEN YC = 15π IF XC > 0 THEN XC = XC - 1 ELSE IF XC < 0 THEN XC = XC + 1π IF YC > 0 THEN YC = YC - 1 ELSE IF YC < 0 THEN YC = YC + 1π Y = Y + YC: X = X + XCπ IF X > 300 THEN X = 300 ELSE IF X < 0 THEN X = 0π IF Y > 180 THEN Y = 180 ELSE IF Y < 0 THEN Y = 0π IF X <> BX OR Y <> BY THENπ WAIT 936, 8: PUT (BX, BY), B, PSETπ GET (X, Y)-(X + 15, Y + 15), B: LINE (X, Y)-(X + 15, Y + 15), 9, BFπ END IFπ LOOP UNTIL KS(1) = 1 'loop until [Esc] (scan code 1) is pressedππ N& = 65535                      'Program the timer back toπ LB& = N& AND &HFF               '18.2hz before exiting!π HB& = (N& / 256) AND &HFFπ OUT &H43, &H3C: OUT &H40, LB&: OUT &H40, HB&ππ OUT &H61, INP(&H61) OR &H82: OUT &H20, &H20π CLEAR   'need to have this if reprograming the timerπ END      'I think this ends the program. I'm not quite sure.. :)ππEric Benson                    DETECT KEYDOWN & KEYUP EVENTS  comp.lang.basic.misc           04-11-96 (18:17)       QB, QBasic, PDS        119  3539     KEYPRESS.BAS'This routine I wrote to detect keydown and keyup events works great (using π'INP(&H60) as someone suggested a while back). To get the ascii of the key thatπ'was pressed I am using INKEY$.  It sometimes returns zero, I guess the BIOSπ'hasn't translated the key when I call INKEY$.  But if you run the programπ'below you may notice a fairly substantial (0.5 sec) delay sometimes.  π'Suggestions to get around this?π'I figure I could load an array with ascii codes and index it with the scancode π'i.e. ascii=scan2ascii(scancode), but I would still need to take care of the π'shift key.π'Or maybe I should run this in straight DOS and not in a Win95 DOS box.ππ'Program Keypress.bas by Eric Benson - April 1996πDEFINT A-ZπDECLARE SUB KernelKeyPress (scancode AS INTEGER, ascii AS INTEGER, keystate AS INTEGER)πREM DECLARE SUB BYTECOPY (SEG SOURCE AS ANY, SEG DESTINATION AS ANY, NUMBYTES&)πCONST TRUE = -1, FALSE = 0πCONST keybuffermax = 10, kdown = 1, kpressed = 2, kup = 3πTYPE keyvarπ  keyin AS INTEGERπ  keyup AS INTEGERπ  scancode AS INTEGERπ  ascii AS INTEGERπ  extended AS INTEGERπEND TYPEππCLSπREM GOTO testπDOπ  keystate = 0π  KernelKeyPress scancode, ascii, keystateπ  IF keystate = kdown THENπ    PRINT "keydown     "; scancode, asciiπ  ELSEIF keystate = kup THENπ    PRINT "keyup       "; scancode, asciiπ  END IFπLOOP UNTIL scancode = 1πENDππtest:π'used to look at what the keyboard is outputingπDOπ  keyin = INP(&H60)π'  LOCATE 1, 1: PRINT "    "π  LOCATE 1, 1: PRINT keyinπ  b$ = INKEY$πLOOP UNTIL keyin = 1πENDππSUB KernelKeyPress (scancode AS INTEGER, ascii AS INTEGER, keystate AS INTEGER)πSTATIC init AS INTEGER, buffer() AS keyvarπSTATIC ibuf AS INTEGER, pressedkey AS INTEGERπIF init THENπ  keyin = INP(&H60)π  b$ = INKEY$π  'Warning inkey$ above does not always trap the keystrokeπ  IF keyin > 128 AND pressedkey THENπ    FOR i = 1 TO ibufπ      IF keyin = 170 OR buffer(i).keyup = keyin THENπ        scancode = buffer(i).scancodeπ        ascii = buffer(i).asciiπ        keystate = kupπ        IF ibuf = 1 THENπ          pressedkey = 0π        ELSEIF i < ibuf THENπ          pressedkey = buffer(i).keyupπ          FOR j = i TO ibuf - 1π            SWAP buffer(j), buffer(j + 1)π          NEXTπ          REM BYTECOPY buffer(i + 1), buffer(i), (ibuf - i) * 10π        ELSEπ          'top key in buffer is unpressedπ          pressedkey = buffer(i).keyupπ        END IFπ        ibuf = ibuf - 1π        EXIT SUBπ      END IFπ    NEXTπ  END IFπ  IF pressedkey <> keyin AND keyin < 129 THENπ    IF ibuf THENπ      FOR i = 1 TO ibufπ        IF buffer(i).keyin = keyin THEN EXIT SUBπ      NEXTπ    END IFπ    IF ibuf < keybuffermax THENπ      ibuf = ibuf + 1π      buffer(ibuf).keyin = keyinπ      buffer(ibuf).keyup = keyin + 128π     π      'Remove this IF..ENDIF block for normal executionπ      'Will hang if shift is pressedπ      IF LEN(b$) = 0 THENπ        DOπ          b$ = INKEY$π        LOOP UNTIL LEN(b$)π      END IFπ     π      IF LEN(b$) = 2 THENπ        buffer(ibuf).extended = ASC(RIGHT$(b$, 1))π      ELSEIF LEN(b$) THENπ        buffer(ibuf).ascii = ASC(b$)π      ELSEπ        buffer(ibuf).ascii = 0π      END IFπ      buffer(ibuf).scancode = keyinπ      pressedkey = keyinπ      scancode = keyinπ      ascii = buffer(ibuf).asciiπ      keystate = kdownπ      EXIT SUBπ    END IFπ  END IFπELSEπ  DIM buffer(1 TO keybuffermax) AS keyvarπ  ibuf = 0π  pressedkey = 0π  init = TRUEπEND IFπEND SUBπJeremy Stanley                 LEFT/RIGHT SHIFT (USING BITS)  FidoNet QUIK_BAS Echo          04-13-96 (11:22)       QB, QBasic, PDS        36   916      BITKEY.BAS  '> "There's a byte in the BIOS area, the bits of which say which Ctrl, Alt andπ'> Shift keys are depressed.  There's another which helps you differentiate leftπ'> from right keys.  But I can't remember what they are... Anyone?"ππ'The first byte in question is at 0040:0017.  This example program shouldπ'demonstrate how to read the status of these keys:ππDEFINT A-ZππCLSπPRINT "Byte at 0040:0017  Press ESC to exit"πPRINT "   - bit 0 - Right shift"πPRINT "   - bit 1 - Left shift"πPRINT "   - bit 2 - Ctrl"πPRINT "   - bit 3 - Alt"πPRINT "   - bit 4 - Scroll lock"πPRINT "   - bit 5 - Num lock"πPRINT "   - bit 6 - Caps lock"πPRINT "   - bit 7 - Insert"ππDEF SEG = &H40ππDOπ  c = PEEK(&H17)π  FOR x = 0 TO 7π    LOCATE x + 2, 1π    e = 2 ^ xπ    PRINT (c AND e) \ eπ  NEXTπLOOP UNTIL INKEY$ = CHR$(27)ππDEF SEGππ'[e-mail]π'http://pages.prodigy.com/perigee/ππTyler Barnes                   MEMORY VIEW                    FidoNet QUIK_BAS Echo          02-25-96 (22:04)       QB, PDS                556  13648    MEMVIEW.BAS DECLARE SUB TLOAD (File$, StartPos&)πDECLARE SUB TSAVE (File$, StartPos&, EndPos&)πDECLARE FUNCTION FileExist% (T$)πDECLARE FUNCTION GETINPUT$ (CHARS%)πDECLARE FUNCTION GETDEC$ (CHARS%)πDECLARE FUNCTION ProgramName$ ()πDECLARE SUB Box (topRow%, topCol%, lowRow%, lowCol%, Frg%, Bkg%)πDECLARE FUNCTION GETHEX$ (CHARS%)πDECLARE SUB FPRINT (NAT$, FL%)πCONST yes = 1, No = 0π'$INCLUDE: 'qb.bi'πSCREEN 0πDEFINT A-ZπStartLoc& = 0πStartSeg& = &H40πBorderColour% = 9πMemColour% = 7πInfoColour% = 15πMode$ = "H"πLiveBytes% = yesπLines% = 25πDIM Mods%(0 TO ((Lines% / 25) * 1439))πWIDTH , Lines%πMax& = 65535 - ((Lines% / 25) * 1439)πMain:πInvalid% = NoπCurEdit% = 0πCOLOR MemColour%, 0πDIM Regs AS RegTypeπLOCATE , , 0πCLSπCOLOR BorderColour%, 0πLOCATE Lines% - CINT((Lines% / 25) * 6.5), 1: PRINT STRING$(80, 196)πCOLOR 0, MemColour%πFOR I% = (Lines% - 2) TO Lines%πLOCATE I%, 1πFPRINT STRING$(80, " "), NoπNEXT I%πLOCATE Lines% - 2, 1πFPRINT "   F1=Edit  F2=Goto Addr  F3=Config  F4=Load file into memory  F5=Memory Dump", NoπLOCATE Lines% - 1, 1πFPRINT "       F6=Compare  F7=About MemoryView  F8=Mode  F9=Mem Search  ESC=Exit", NoπLOCATE Lines%, 1πFPRINT "   Use Pgup, Pgdn, Home, End, and arrow keys to move inside selected segment", NoπUpdate% = yesπDOπK$ = INKEY$πIF LEN(K$) THEN GOSUB MoveπIF Update% = yes THENπRegs.ax = &HB00πRegs.bx = BorderColour%πCALL INTERRUPT(&H10, Regs, Regs)πCOLOR MemColour%, 0πCOLOR InfoColour%, 0πIF LiveBytes% = yes THEN Update% = NoπLOCATE Lines% - 5, 1: FPRINT "Segment: " + HEX$(StartSeg&) + "h     ", NoπLOCATE Lines% - 4, 1: FPRINT "Offset: " + HEX$(StartLoc&) + "h to ", NoπFPRINT HEX$(StartLoc& + ((Lines% / 25) * 1439)) + "h          ", NoπLOCATE Lines% - 3, 1πPRINT "Mode: ";πIF Mode$ = "H" THEN PRINT "Hex" ELSE PRINT "Dec"πEND IFπSL% = -2πIF LiveBytes% = yes OR (LiveBytes% = No AND Update% = yes) THENπUpdate% = NoπFOR I& = StartLoc& TO StartLoc& + INT(Lines% / 25) * 1439πSL% = SL% + 2πDEF SEG = StartSeg&πChar% = PEEK(I&)πDEF SEG = &HB800πPOKE SL%, Char%πNEXT I&πEND IFπLOOPπMove:πSELECT CASE K$πCASE CHR$(0) + "M", "6": StartLoc& = StartLoc& + 1πIF StartLoc& > Max& THEN StartLoc& = Max&πCASE CHR$(0) + "K", "4": StartLoc& = StartLoc& - 1πIF StartLoc& < 0 THEN StartLoc& = 0πCASE CHR$(0) + "H", "8": StartLoc& = StartLoc& - 80πIF StartLoc& < 0 THEN StartLoc& = StartLoc& + 80πCASE CHR$(0) + "P", "2": StartLoc& = StartLoc& + 80πIF StartLoc& > Max& THEN StartLoc& = StartLoc& - 80πCASE CHR$(0) + "Q", "3": StartLoc& = StartLoc& + 1440πIF StartLoc& > Max& THEN StartLoc& = StartLoc& - 1440πCASE CHR$(0) + "I", "9": StartLoc& = StartLoc& - 1440πIF StartLoc& < 0 THEN StartLoc& = StartLoc& + 1440πCASE CHR$(0) + "G", "7": StartLoc& = 0πCASE CHR$(0) + "O", "1": StartLoc& = Max&πCASE CHR$(0) + "A"πIT% = InfoColour%: BT% = BorderColour%πBox 5, 26, 12, 52, InfoColour%, BorderColour%πCOLOR InfoColour%, BorderColour%πLOCATE 6, 28πSOUND 50, 1πFPRINT "  MemView Version 0.3", NoπLOCATE 8, 28πFPRINT "By D. Tyler Barnes,1996", NoπLOCATE 10, 28πFPRINT "       FREEWARE!", NoπLOCATE 11, 28πFPRINT " Tested on a 486dx2 80", NoπInfoColour% = IT%: BorderColour% = BT%πDO: Junk$ = INKEY$: LOOP UNTIL LEN(Junk$)πDEF SEG = &HB800πFOR C% = 691 TO 2027 STEP 2πPOKE C%, MemColour%πNEXT C%πCASE "", "", CHR$(0) + "", "Q", "q", "X", "x"πCOLOR 7, 0πRegs.ax = &HB00πRegs.bx = 0πCALL INTERRUPT(&H10, Regs, Regs)πCLSπENDπCASE CHR$(0) + "<"πLOCATE Lines% - 5, 40, 1πCOLOR InfoColour%, 0: FPRINT "Segment:Offset = ", NoπLastKey$ = ""πSeg$ = GETHEX$(4)πIF Seg$ = "" THEN GOTO NoMatterπLOCATE Lines% - 5, 62πFPRINT ": ", NoπOff$ = GETHEX$(4)πIF Off$ = "" THEN Off$ = "0000"πStartLoc& = VAL("&H" + Off$)πIF StartLoc& < 0 THEN StartLoc& = StartLoc& + 65536πIF StartLoc& > Max& THEN StartLoc& = Max&πStartSeg& = VAL("&H" + Seg$)πIF StartSeg& < 0 THEN StartSeg& = StartSeg& + 65536πNoMatter:πLOCATE Lines% - 5, 40, 0π2 FPRINT SPACE$(29), NoπCASE CHR$(0) + ";": GOSUB ByteEditor: GOTO MainπCASE CHR$(0) + "?"πTryAgain:πFOR R% = (Lines% - 5) TO (Lines% - 3)πLOCATE R%, 30, 0πFPRINT SPACE$(40), NoπNEXT R%πLOCATE Lines% - 5, 30, 1πFPRINT "Save memory dump as:", NoπF$ = GETINPUT$(12)πIF F$ = "" THEN GOTO FinishedπFE% = FileExist(F$)πIF FE% = yes THENπFOR R% = Lines% - 5 TO Lines% - 3πLOCATE R%, 30, 0πFPRINT SPACE$(40), NoπNEXT R%πBEEPπLOCATE Lines% - 5, 30: PRINT "File Exists!"πLOCATE Lines% - 4, 30: PRINT "Hit any key..."πDO: A$ = INKEY$: LOOP UNTIL LEN(A$)πGOTO TryAgainπEND IFπON ERROR GOTO InvalidFilenameπOPEN F$ FOR BINARY AS 1πON ERROR GOTO EHπCLOSE 1πIF Invalid% = yes THEN Invalid% = No: GOTO TryAgainπLOCATE Lines% - 4, 30: FPRINT "Offset ____h to ____h", NoπLastKey$ = ""πLOCATE Lines% - 4, 37: FO$ = GETHEX$(4)πLOCATE Lines% - 4, 46: SO$ = GETHEX$(4)πDEF SEG = StartSeg&πLOCATE Lines% - 3, 29πTSAVE F$, VAL("&H" + FO$), VAL("&H" + SO$)πFinished:πCOLOR MemColour%, 0πFOR R% = Lines% - 5 TO Lines% - 3πLOCATE R%, 30, 0πFPRINT SPACE$(40), NoπNEXT R%πCASE CHR$(0) + ">"πLOCATE Lines% - 5, 30, 1πFPRINT "Load File:", NoπF$ = GETINPUT$(12)πLOCATE , , 0πIF FileExist(F$) = No THENπBEEPπLOCATE Lines% - 5, 30πFPRINT "File Not Found!", NoπLOCATE Lines% - 4, 30πFPRINT "Hit Any Key...", NoπDO: A$ = INKEY$: LOOP UNTIL LEN(A$)πGOTO FinishedLoadπEND IFπLOCATE Lines% - 4, 30πFPRINT "Offset:____h", NoπLOCATE Lines% - 4, 37, 1πLastKey$ = ""πO$ = GETHEX$(4)πDEF SEG = StartSeg&πLOCATE Lines% - 3, 30, 0πTLOAD F$, VAL("&H" + O$)πFinishedLoad:πFOR L% = Lines% - 5 TO Lines% - 3πLOCATE L%, 30, 0πFPRINT SPACE$(20), NoπNEXT L%πCASE "[", "<", ",": StartSeg& = StartSeg& - 1πIF StartSeg& < 0 THEN StartSeg& = 0πCASE "]", ".", ">": StartSeg& = StartSeg& + 1πIF StartSeg& > 65535 THEN StartSeg& = 65535πEND SELECTπEndSelect:πLOCATE , , 0πUpdate% = yesπRETURNπByteEditor:πCOLOR 0, MemColour%πFOR I% = Lines% - 2 TO Lines%πLOCATE I%, 1πFPRINT SPACE$(80), NoπNEXT I%πLOCATE Lines% - 2, 1πFPRINT "F1 = Enter Hex Value   F2 = Enter Decimal Value   F3 = Quit   F4 = Save and Quit", NoπLOCATE Lines% - 1, 1πLOCATE Lines%, 1πFPRINT "        Use Pgup, Pgdn, Home, End, and arrow keys to move within window", NoπCOLOR InfoColour%, 0πU2% = yes: Typed% = No: SaveIt% = NoπLOCATE , , 1πCurCol% = CurEdit%πFOR I% = 0 TO ((Lines% / 25) * 1439)πDEF SEG = StartSeg&πMods%(I%) = PEEK(StartLoc& + I%)πDEF SEG = &HB800πPOKE I% * 2, Mods%(I%)πNEXT I%πDOπK$ = INKEY$πNewVal:πIF LEN(K$) THEN U2% = yesπSELECT CASE K$πCASE CHR$(0) + "M", "6": CurCol% = CurCol% + 2πIF CurCol% > 2879 THEN CurCol% = CurCol% - 2πCASE CHR$(0) + "K", "4": CurCol% = CurCol% - 2πIF CurCol% < 0 THEN CurCol% = CurCol% + 2πCASE CHR$(0) + "H", "8": CurCol% = CurCol% - 160πIF CurCol% < 0 THEN CurCol% = CurCol% + 160πCASE CHR$(0) + "P", "2": CurCol% = CurCol% + 160πIF CurCol% > 2879 THEN CurCol% = CurCol% - 160πCASE CHR$(0) + "G": CurCol% = 0πCASE CHR$(0) + "O": CurCol% = (Lines% / 25) * 2878πCASE CHR$(0) + "I": CurCol% = CurCol% - ((Y% - 1) * 160)πCASE CHR$(0) + "Q": CurCol% = CurCol% + ((17 * 160) - ((Y% - 1) * 160))πCASE CHR$(0) + ";"πLOCATE Lines% - 5, 20, 1πFPRINT "Hex:", NoπLastKey$ = ""πH$ = GETHEX$(2)πK$ = CHR$(VAL("&H" + H$))πLOCATE Lines% - 5, 20, 0: PRINT "       ";πGOTO NewValπCASE CHR$(0) + "<"πReEnter:πLOCATE Lines% - 5, 20, 0πPRINT SPACE$(30);πLOCATE Lines% - 5, 20, 1πFPRINT "Dec:", NoπLastKey$ = ""πH$ = GETDEC$(3)πIF VAL(H$) > 255 THEN GOTO ReEnterπK$ = CHR$(VAL(H$))πLOCATE Lines% - 5, 20, 0: PRINT "       ";πGOTO NewValπCASE ""πCASE CHR$(0) + "=": SaveIt% = No: EXIT DOπCASE CHR$(0) + ">": SaveIt% = yes: EXIT DOπCASE ELSEπTyped% = yesπMods%(INT(CurCol% / 2)) = ASC(K$)πCurCol% = CurCol% + 2πIF CurCol% > ((Lines% / 25) * 2878) THEN CurCol% = ((Lines% / 25) * 2878)πEND SELECTπIF U2% = yes THENπY% = INT(CurCol% / 160) + 1πX% = (INT(CurCol% / 2) + 1) - (80 * (INT(CurCol% / 160)))πMemPos& = INT(CurCol% / 2) + StartLoc&πDEF SEG = StartSeg&πCurByte% = Mods%(INT(CurCol% / 2))πFOR C% = Lines% - 5 TO Lines% - 3πLOCATE C%, 1: PRINT SPACE$(80);πNEXT C%πLOCATE Lines% - 5, 1: PRINT "Segment: "; HEX$(StartSeg&) + "h"πLOCATE Lines% - 4, 1: PRINT "Offset: "; HEX$(MemPos&) + "h"πLOCATE Lines% - 3, 1: PRINT "Char:"; HEX$(CurByte%) + "h (" + LTRIM$(STR$(CurByte%)) + "d)"πDEF SEG = &HB800πLOCATE Y%, X%, 1: POKE CurCol%, CurByte%πIF Typed% = yes THEN POKE CurCol% - 2, Mods%(INT((CurCol% - 2) / 2)): Typed% = NoπU2% = NoπEND IFπLOOPπIF SaveIt% = yes THENπDEF SEG = StartSeg&πFOR I% = 0 TO (Lines% / 25) * 1439πPOKE StartLoc& + I%, Mods%(I%)πNEXT I%πEND IFπLOCATE , , 0πRETURNπEH:πCLSπCOLOR 7, 0πPRINT "FATAL ERROR; PROGRAM HALTED."πPRINT "Error#"; ERRπENDπInvalidFilename:πInvalid% = yesπRESUME NEXTππSUB Box (topRow%, topCol%, lowRow%, lowCol%, Frg%, Bkg%)πCOLOR Bkg%, Bkg%πIF Bkg% >= 8 THEN Bkg% = Bkg% - 8πFOR I% = topRow% TO lowRow%πLOCATE I% + 1, topCol% + 2πPRINT STRING$(lowCol% - topCol% + 1, 176)πNEXT I%πCOLOR Bkg%, Frg%πFOR I% = topRow% TO lowRow%πLOCATE I%, topCol%πPRINT STRING$(lowCol% - topCol% + 1, 219)πNEXT I%πCOLOR Frg%, Bkg%πLOCATE topRow%, topCol%πPRINT "┌" + STRING$(lowCol% - topCol% - 1, 196) + "┐"πFOR I% = (topRow% + 1) TO (lowRow% - 1)πLOCATE I%, topCol%πPRINT "│"πLOCATE I%, lowCol%πPRINT "│"πNEXTπLOCATE lowRow%, topCol%πPRINT "└" + STRING$(lowCol% - topCol% - 1, 196) + "┘"πCOLOR 7, 0πEND SUBππDEFSNG A-ZπFUNCTION FileExist% (T$)πDEFINT A-ZπDIM F AS STRING * 64πDIM Inx AS RegTypeXπDIM Outx AS RegTypeXπInx.ax = &H2F00πCALL INTERRUPTX(&H21, Inx, Outx)πDTASeg = Outx.esπDTAAddr = Outx.bxπF$ = LTRIM$(RTRIM$(UCASE$(T$))) + CHR$(0)πInx.ds = VARSEG(F$)πInx.dx = VARPTR(F$)πInx.ax = &H4E00πInx.cx = -1πCALL INTERRUPTX(&H21, Inx, Outx)πIF Outx.flags AND 1 THENπFileExist% = 0πELSEπFileExist% = 1πEND IFπEND FUNCTIONππSUB FPRINT (NAT$, FL%)πYT = (80 - POS(0)) + 1πBS = INSTR(LEFT$(NAT$, YT), "")πIF BS < 1 THENπPRINT LEFT$(NAT$, YT);πELSEπBST$ = LEFT$(NAT$, YT): GOSUB PrintWithBackspacesπEND IFπIF LEN(NAT$) - YT > 0 THENπBS = INSTR(RIGHT$(NAT$, LEN(NAT$) - YT), "")πELSEπBS = 0πEND IFπIF BS < 1 THENπIF LEN(NAT$) - YT > 0 THEN PRINT RIGHT$(NAT$, LEN(NAT$) - YT);πELSEπBST$ = RIGHT$(NAT$, LEN(NAT$) - YT): GOSUB PrintWithBackspacesπEND IFπIF FL = yes THEN PRINTπEXIT SUBπPrintWithBackspaces:πDO UNTIL INSTR(BST$, "") < 1πTBP = INSTR(BST$, "")πPRINT LEFT$(BST$, TBP - 1);πIF POS(0) > 1 THENπLOCATE CSRLIN, POS(0) - 1: PRINT " "; : LOCATE CSRLIN, POS(0) - 1πEND IFπBST$ = RIGHT$(BST$, LEN(BST$) - TBP)πLOOPπPRINT BST$;πRETURNπEND SUBππFUNCTION GETDEC$ (CHARS)πSHARED LastKey$πLOCATE , , 1πDOπIF LEN(LastKey$) THENπA$ = LastKey$πLastKey$ = ""πELSEπA$ = UCASE$(INKEY$)πEND IFπSELECT CASE A$πCASE ""πIF Counter > 0 THENπCounter = Counter - 1πPRINT " ";πTotal$ = LEFT$(Total$, LEN(Total$) - 1)πEND IFπCASE ""πCASE "0", "1", "2", "3", "4", "5", "6", "7", "8", "9"πIF Counter < CHARS THENπCounter = Counter + 1πPRINT A$;πTotal$ = Total$ + A$πELSEπLastKey$ = A$πEXIT DOπEND IFπEND SELECTπLOOP UNTIL A$ = CHR$(13)πDO UNTIL LEN(Total$) = CHARSπTotal$ = "0" + Total$πLOOPπPRINTπGETDEC$ = Total$πEND FUNCTIONππFUNCTION GETHEX$ (CHARS)πSHARED LastKey$πLOCATE , , 1πDOπIF LEN(LastKey$) THENπA$ = LastKey$πLastKey$ = ""πELSEπA$ = UCASE$(INKEY$)πEND IFπSELECT CASE A$πCASE ""πIF Counter > 0 THENπCounter = Counter - 1πPRINT " ";πTotal$ = LEFT$(Total$, LEN(Total$) - 1)πEND IFπCASE ""πCASE "0", "1", "2", "3", "4", "5", "6", "7", "8", "9", "A", "B", "C", "D", "E", "F"πIF Counter < CHARS THENπCounter = Counter + 1πPRINT A$;πTotal$ = Total$ + A$πELSEπLastKey$ = A$πEXIT DOπEND IFπEND SELECTπLOOP UNTIL A$ = CHR$(13)πIF LEN(Total$) THENπDO UNTIL LEN(Total$) = CHARSπTotal$ = "0" + Total$πLOOPπEND IFπPRINTπGETHEX$ = Total$πEND FUNCTIONππFUNCTION GETINPUT$ (CHARS)πLOCATE , , 1πDOπA$ = UCASE$(INKEY$)πSELECT CASE A$πCASE ""πIF Counter > 0 THENπCounter = Counter - 1πPRINT " ";πTotal$ = LEFT$(Total$, LEN(Total$) - 1)πEND IFπCASE "", ";", "*", "?", "/", "\", ":", ""πCASE CHR$(13): EXIT DOπCASE ELSEπIF Counter < CHARS THENπCounter = Counter + 1πPRINT A$;πTotal$ = Total$ + A$πEND IFπEND SELECTπLOOP UNTIL A$ = CHR$(13)πPRINTπGETINPUT$ = Total$πEND FUNCTIONππFUNCTION ProgramName$ STATICπDIM Regs AS RegTypeπRegs.ax = &H5100πINTERRUPT &H21, Regs, RegsπDEF SEG = Regs.bxπEnvSeg% = PEEK(&H2C) + PEEK(&H2D) * 256πDEF SEG = EnvSeg%πDOπByte% = PEEK(Offset%)πIF Byte% = 0 THENπCount% = Count% + 1πIF Count% AND EXEFlag% THENπEXIT DOπELSEIF Count% = 2 THENπEXEFlag% = -1πOffset% = Offset% + 2πEND IFπELSEπCount% = 0πIF EXEFlag% THENπTemp$ = Temp$ + CHR$(Byte%)πEND IFπEND IFπOffset% = Offset% + 1πLOOPπDEF SEGπProgramName$ = Temp$πTemp$ = ""πEND FUNCTIONππSUB TLOAD (File$, StartPos&)πL = CSRLIN: C = POS(0)πIF StartPos& < 0 THEN StartPos& = StartPos& + 65536πIF EndPos& < 0 THEN EndPos& = EndPos& + 65536πZ% = FREEFILEπOPEN File$ FOR BINARY AS Z%πFLength& = LOF(Z%)πDO UNTIL EOF(Z%)πData$ = INPUT$(1, Z%)πIF LEN(Data$) THEN POKE StartPos&, ASC(Data$)πLOCATE L, C, 0πPRINT INT((LOC(Z%) / FLength&) * 100); "%";πStartPos& = StartPos& + 1πLOOPπCLOSE Z%πEND SUBππSUB TSAVE (File$, StartPos&, EndPos&)πL = CSRLIN: C = POS(0)πIF StartPos& < 0 THEN StartPos& = StartPos& + 65536πIF EndPos& < 0 THEN EndPos& = EndPos& + 65536πZ% = FREEFILEπOPEN File$ FOR OUTPUT AS Z%πFOR C& = StartPos& TO EndPos& STEP 1πPRINT #Z%, CHR$(PEEK(C&));πLOCATE L, C, 0πPRINT INT((C& / EndPos&) * 100); "%";πNEXT C&πCLOSE Z%πEND SUBππThe ABC Programmer             SIMPLE QWK READER              Try ADVANCED QWK READER        03-06-96 (17:43)       QB, QBasic, PDS        166  5089     QWKREAD.BAS '===================[ Simple Little QWK Reader ]=======================π'π' This SIMPLE little ditty let's you read SWAG or QWK files which haveπ' EXACTLY the same format.  Additions to dump to file implemented.π' Original PASCAL code by Swag Support Team (Gayle Davis)π' Converted and optimized to BASIC by William Yu (03-06-96)π'π'----------------------------------------------------------------------ππDECLARE SUB DumpHeader (QWK AS ANY)πDECLARE SUB ReadMessage (HDR AS ANY, RelNum&, Chunks)πDECLARE SUB ReadMsg (NumChunks)πDECLARE SUB ReadWriteHdr (QWK AS ANY)ππCONST Height = 25                     ' 25/43/50πCONST False = 0                       ' False = 0πCONST True = NOT False                ' True = -1πCONST DumpQWKtoFile = False           ' Dump messages to file?π                                      ' True = Dump to fileπ                                      ' False = View from screenπCONST DumpQWKFileName$ = "DUMP.MSG"   ' Dump messages to this file nameπCONST QWKPacket$ = "MESSAGES.DAT"     ' MESSAGES.DAT or *.SWGπ                                      ' Specify the path if requiredπTYPE MSGDatHdr                        ' MESSAGES.DAT File Structureπ    Status   AS STRING * 1            '  128 bytes altogetherπ    MSGNum   AS STRING * 7π    Date     AS STRING * 8π    Time     AS STRING * 5π    UpTO     AS STRING * 25           ' Always UpperCaseπ    UpFROM   AS STRING * 25           ' Always UpperCaseπ    Subject  AS STRING * 25π    PassWord AS STRING * 12           ' Never/rarely usedπ    ReferNum AS STRING * 8π    NumChunk AS STRING * 6π    Alive    AS STRING * 1π    LeastSig AS STRING * 1            ' Conference #π    MostSig  AS STRING * 1            ' Used for conf. # greater than 255π    Reserved AS STRING * 3πEND TYPEππDIM QWK AS MSGDatHdrππWIDTH 80, HeightπCLSππ  OPEN QWKPacket$ FOR BINARY AS #1π  IF DumpQWKtoFile THEN OPEN DumpQWKFileName$ FOR OUTPUT AS #2π  SEEK #1, 129  ' Skip Copyright informationπ  Count& = 129π  WHILE Count& < LOF(1)π        ReadMessage QWK, Count&, Chunksπ        IF DumpQWKtoFile THENπ          LOCATE 1, 1: PRINT "Complete:";π          PRINT USING "###.#%"; (Count& + (128 * Chunks)) / LOF(1) * 100π          PRINT #2,π          A$ = INKEY$                        ' ESC Key quits dumpingπ        ELSEπ          PRINTπ          PRINT "Press any key to continue .. (ESC Key quits)";π          A$ = INPUT$(1)π          CLSπ        END IFπ        IF A$ = CHR$(27) THEN CLOSE : END    ' ESC quits Viewing or Dumpingπ        Count& = Count& + (128 * Chunks)π  WENDπ  CLOSEπ  ENDππSUB DumpHeader (QWK AS MSGDatHdr)π   π    PRINT #2, STRING$(80, "=")π    PRINT #2, "   Date: "; QWK.Date; " ("; QWK.Time; ")";π    PRINT #2, , , "Number: "; QWK.MSGNumπ    PRINT #2, "   From: "; QWK.UpFROM;π    PRINT #2, , "Refer#: "; QWK.ReferNumπ    PRINT #2, "     To: "; QWK.UpTO;π    PRINT #2, , " Recvd: ";π    InCase$ = "-`^#"π    IF INSTR(QWK.Status, InCase$) THENπ      PRINT #2, "YES"π    ELSEπ      PRINT #2, "NO"π    END IFπ    PRINT #2, "Subject: "; QWK.Subject;π    Conference$ = LTRIM$(STR$(ASC(QWK.MostSig) * 256 + ASC(QWK.LeastSig)))π    PRINT #2, , "  Conf: "; "("; Conference$; ")"π    PRINT #2, STRING$(80, "-")ππEND SUBππSUB ReadMessage (QWK AS MSGDatHdr, RelNum&, Chunks)π π  SEEK #1, RelNum&π  ReadWriteHdr QWKπ  Chunks = VAL(QWK.NumChunk)π  ReadMsg ChunksππEND SUBππSUB ReadMsg (NumChunks)ππ  DIM Buff AS STRING * 128ππ  FOR J = 1 TO NumChunks - 1π    GET #1, , Buffπ    FOR I = 1 TO 128π      IF MID$(Buff, I, 1) = CHR$(227) THENπ        IF DumpQWKtoFile THEN PRINT #2,  ELSE PRINTπ      ELSEπ        IF DumpQWKtoFile THENπ          PRINT #2, MID$(Buff, I, 1);π        ELSEπ          PRINT MID$(Buff, I, 1);π        END IFπ      END IFπ      IF CSRLIN = Height - 1 THENπ        LOCATE Height, 1: PRINT "Hit Any Key for Next Page...";π        A$ = INPUT$(1)π        LOCATE 6, 1: PRINT STRING$((Height - 7) * 80, " ");π        LOCATE 6, 1π      END IFπ    NEXT Iπ  NEXT JππEND SUBππSUB ReadWriteHdr (QWK AS MSGDatHdr)ππ    GET #1, , QWK.Statusπ    GET #1, , QWK.MSGNumπ    GET #1, , QWK.Dateπ    GET #1, , QWK.Timeπ    GET #1, , QWK.UpTOπ    GET #1, , QWK.UpFROMπ    GET #1, , QWK.Subjectπ    GET #1, , QWK.PassWordπ    GET #1, , QWK.ReferNumπ    GET #1, , QWK.NumChunkπ    GET #1, , QWK.Aliveπ    GET #1, , QWK.LeastSigπ    GET #1, , QWK.MostSigπ    GET #1, , QWK.Reservedππ  IF DumpQWKtoFile THENπ    DumpHeader QWKπ  ELSEπ    PRINT "Date: "; QWK.Date; " ("; QWK.Time; ")";π    PRINT , , "Number: "; QWK.MSGNumπ    PRINT "From: "; QWK.UpFROM;π    PRINT , "Refer#: "; QWK.ReferNumπ    PRINT "  To: "; QWK.UpTO;π    PRINT , " Recvd: ";π    InCase$ = "-`^#"π    IF INSTR(QWK.Status, InCase$) THENπ      PRINT "YES"π    ELSEπ      PRINT "NO"π    END IFπ    PRINT "Subj: "; QWK.Subject;π    Conference$ = LTRIM$(STR$(ASC(QWK.MostSig) * 256 + ASC(QWK.LeastSig)))π    PRINT , "  Conf: "; "("; Conference$; ")"π    PRINT STRING$(80, "-");π  END IFππEND SUBππJustin McCall                  CREATE WORD SEARCH PUZZLES     www.earthlink.net              08-22-95 (17:09)       QB, QBasic, PDS        144  9548     PUZZLE.BAS  DEFINT A-Z:DIM SHARED K,S,B&,Z&:V1 'Created by PostIt! 7.2πSUB V1:OPEN "O",1,"WPUZZLE.ZIP",4^6:Z&=6895:?STRING$(50,177);πU"%up()%9%%%#-%^X7;DNo1=DV5R%%H#%%%0%.%%&u1z))q%jSgfaxfBTb=Tko9R'πU"m4=8N9oN.kYsjITYfSTGDX.7kEMnxsl+7uH361Gb-n5[^MzMOL';tP7f\L',;PVπU"qn,B3^+G>HC+y2KPi)baX$[$EEk^6d]hl-V*EL8>RWY^rqEeWXY6R\[$*j#*8hbπU"N)Red.K'aCFsCuq\o=JNTB>wNnR8vHvM2>mW,JZtl#5lls/H_mq'U6MOr^w1\^bπU"n16[tXue?tlZICgy1?m^N>HSS=:YC5kH$Cg)O9TPlN>;UnUW^e\.Tmw+/p/y1i=πU"-c;XF:<'\ta:sBh(_g89%u1v.+JEP3^C%P9:/cf4+l)vS:MUsy7*tKrAs6mIeTaπU"9g/XdnJS9JVG5,8Fb?uYGG3OZC21f_[B((bEEKBI3#I:/>RBjaG(Y>qR,SrgJ?%πU"o5_z/%I[bbmFh*k1c$*Revev[.kpb?7%F<kmI\l:^vRbU^JLHTX+>Mo$rT:hT6,πU"I)EkX,T5]dnVPuPmFsvNy=]b5fNm[IXfU8y.^/LicPl:9z';oI&:2z7t$D4:Ld/πU"M\Tej4vl.kcF/Z2pVz):?)11%Twzck2R;I3:f/hHp_HtDThsI=Sn:^Z<$elORJnπU"hTV'9p[n042o?#cYGxW=gd<l7%M%Ih_vJcaDR54Kp*0A<&&k>aK#?3iCQbc:/^bπU"F+X**HIS<1X:(^<m:bYW_,%FV+r0)634].?pG95g=NEi)wbr]1gQcwGNd+TY=x4πU")vfu<_fi;heRrICpPB/C5G1DgAqxiB1_)5mulj=M4/%#11[i/k9M_'')GudP7]BπU"K=e9c/^zvrfL.x,GG_I&p,2t0yT7,SEl(Fmc>poRM%9+FIkDO9ocT9YDtWY2LcbπU"ofZHM9hl/97OxAbaxn[,sRK#>]ed(;S5ZEeZ/kAPJVwb2X4Zuoi%?[.>:Ym)Ca2πU"-lY?bO?9#6575o,U8J6Q4E0#u*_Y])LZR7QH+:x1s\1sW/l;mfd-v2F3gX[H+w%πU"Z=/XkPxCdW'%4J9WE6rUe%G<t0'[E38MFPcFX'89?eu%F$S=uAGNBn?DUJ-Hn:/πU"=<<4$2UspYDt4<'EWQPg9WWQ\v69M;*-:O9T(4mRzFeouNe.0>Z]2IWL86C3/ZdπU"7m94XN.3oSS0glK;'Iq'2RGlQl:xHMPRO4KfmyCca2-]XF[W6KZW%BiAcUE-0'qπU"[J+s2D*,(iEQ9H1(m/I^vyqmMQEtJ2ixdEi'<R,6]o*lr=7u5=:G(TYN/5NUV7UπU"%E?rE8eH4tkdXJR\UI/Q&f;5.(9:^S'oRpvmYQO.)g2fC-r&+lTc(A#P6Y8hm/HπU"e::G/tie#[A^jvp<t5ZIv'<Q?2/o2fRH;uJZ+&lnhyFat7FcSAQ$gvakDp-aGEKπU")g=VmmR*6RcWfT/p&YVogdwG_/BfgIuph$aw?3D$X1j9Ive\I>PWR%)ayzO_4/jπU".5[^1Vei3-be:$7CV,5?&'<*'m'Ss(dBqdqe8FpuMMXP9>oF<7R.ErO4BY5yz#yπU"bvP=MXvW\Ur6)?2&?C_96l5h]P(^1tkB/.#1HiQwYpT%N</N_+]7aF7uz8;jc/'πU"hJG[;Q%E<:Y=DeFXIoQ7]MyIE.HhLbE2)w]?_-t(AvPIv8>#5Lt%C9%tSSuftnsπU"dh+ae\1F.tLor8Msk+j9\:?u_M*E0M%5=&62>_IBUp3:cs.qN%i&sYw>hl7beKNπU"r&&co8KZx/ifJdOpqDWZH#Bf1Q&P=Q+2?V.0<41^0&B,8siB;#-g->-Lu%cSdI%πU"*YYO+J&oFj)(7gLwC<kT3Ie;*W):9$3DYkQeFTZ)f84rNWXU1oI3wCI0ASF&=nUπU"XYr;B?b,HWa.;Wq%4JkaHpup\lM9?t]r\1C?$ERt/H_I=FEg\C.p1&FC4PU1Um$πU">O'wlg<+bM\Ha(<HBMB]k=\_LGU:J=3YbJ#((8(e#kc)66(:#/qAL2JdH4l6(JVπU"3B#\h8-k\QXg*ig,D?[A:M>s\m+rH(H2SfjwKLs\??NRhRf6:aA0S,d=sHk2Rh^πU",Vh:Gb=swkqD[5bS*fj.)iArSTpP,'EvBw3N%>c?<Cc<blg.qL?gJ_<Y%$ye5<aπU";%p:t04%&NK^(O'lC.W707v6mC[oEfII-UT=B,EFg;)S$WDQtj7'B-zR3;X[uTLπU"G-4bS3;ZmykQL4G5_6-o.-T)4S(R%glkULO)[&p/UWO](:16**<*h,>f\/YUWU,πU"d*h>h#X*h>*iB*h>>j0/YUW]]VQp0HIt>JI,jp:1-6F,/tUW_XIO=IjA.M=I,j8πU"xU9m[xsu:ITuLb\O?WqQvHV'^UHq3M3xYF?r+_NIpWFy%H-[OapDhu0R_G2h,?2πU"R)Db)#VX<oU1#lkviY[>A3SUqZ+vb%=RKyjw[dQjUdKciG5oV_:pY^u<ItYIsWSπU"([p+$.]4*$GKIh>htWJIxcBC'PVTD9W6;SK3Tn-5ymGrpeink'D$hFmEI7;g1RRπU"7[1>5/u.%n,)M6^f*a=cC$N2'gZ5&I7tPlCLAu1#TvJ06C[l'/Eh)CH?hc0)_6CπU"6bs]\gJ$i\arQr9e=kZiCSS?#H))Q/,4\Dc?G4w2^FL_oSoAwkaWkd\'i42\VMJπU";>7,gby*1n-E+greMW#XY;%6rBnd>3SF%b?-po(NR+UM)l46x*?7B&nEvW-/ZsZπU"f6[<ts%R\^iMABD^Pwz^E^9eCex4'Fb/?fF08JR2Tu'ouXfV6unp&D7d&U3CqvMπU"].ZMH.CAbFXj'e7^1FZ$Jc&,zKIphp8VAqKGOq<eu)aW%l,7ce?eu256>gu>0S3πU"Gj;%Ivc6P$DGO>E,VpG3/pr/p?>\<FG4.$?jmc7\H?03j1\<hVlob<VG\VE82l\πU"F\J>>O\JGbp,95:.ZWl>523?0?BP1v$B5IT[f=y=2mP361P,L6MuyDg]xDi&=8aπU"&8Ihc1xiYP)cc=8f(S>S&WN&Ea<4J.;Ih(qigPT-e/bbknMR7H6biD1XJ+(/i]MπU"*,%2iePuYiE%$$kjSa,Ad+b(GgAe\)tc[p,4cJQC=r\A+dB[#,5fS4qDQ=vkTFaπU".$q(W&Z4=Ejm-aVfk]]h)-7]a?_Zm[d,4c1QC?v\Ab6A[4,5f14tF;^';rmY_7WπU"t7FE15/eXloWa%SK;bPD95h3Ah2=0=]UE;r2A]\rdy#aU13VN;-Q*\'G3DTO:]#πU"Q68s*&WjtB<'(3'/B0R=K053Cm0>4;E<C0lNDL1NIN,tq8JYH<eyL1n#IwBWKNfπU"sIpI%\Ng#t-[:cY+D+nulV#'m9QCMTeq4E(+5LL^\S;fKNZ2Z?\m;GDo+;6:rA(πU"bLuIjUXo>==k'DJ&ARv$tYwlp^QC/.:J$[1^<*pSJGLuHRNE$61>X4H-=(h%]r,πU"s17X&^Bj8R#BO#=DX?UktT/-riLeMyv3(wlk:hKrSag8SI>nabP_yvXe:E(wbjfπU"pIrd(jMco/,Bkoh0mnfk,YufER_nt&]kb7/Q22KqR(Tbtp'm[m)<CAXLIKJTZ'RπU"Pk._&)4p)7GW)z/Wa\uz6ljVt()^SFVr15OLA%rbFDgrblfX$Xl'hVt5#qmsrO3πU"Gd:ag<gO6Ko_[gx]](iSYN&35,>DW_;T,ssye[l06/3C/2jmBn+Op=;%)7HnS_JπU"b[e=XEJV2Q)*CR4.Val2c^;gHMQ5%cpJWoW>d5Oi6d0>O8[o,p6YP?.c#%vH?[yπU"6GUuLF]^TSSc&9d1X$xq?/5*(kbZ4#\iwT(&G6%js9N_D_di/%M0K?Ivi)qegJ&πU"IxoCfueb&ZKC7q4j5M%%daV3C1GkYRu^1M_bsC7[ZrIPKZhK%gH4:Fz/k3I8feRπU"ZZmMq=%C0<N\<h;ULBZtSN('U3W<grU::4%f6yG?U/c,kn%BFGQer_<Jk7Eu7/qπU"l^&a-C&$:AuIbg&6B6#P8XQA42A7=X.FLxc-qP%er%U5EuGPx.^r40m_MpaL2%OπU"m1UrZl*f0%LNd3i$7Zb$ur05$Zd0uLpKNXUigt/j'>Pft:Ivb+q3S)NVuxQ:uqgπU"b_=JHq2^3F5u/Lfn2lqSvskv3=($zoskMWPIK(_7N+>WjTe&kEJ8bVosU_TFFoOπU"8n7\2#IX]ZS5O?KJA[pqcr21()r574l(qDP(r55r:c2\jIFd-Z5IAgo1pf-BH<CπU"ob5ua[%\wM=0UZp=0kgwW.d*jMkwJZie?\MLp*n1%+4$>BmE\D9pd3xR<1ZNSm4πU"'KlqpJ+3pFXruV<H<rj3qvK=:FDlx8>cD-MtFts\UjfDDC_lbrv<5x1T#JDvVD\πU"LWu0M'HZdkV<de^*szK_ArrM7FX_Q4pmR%^_wB-H$s>1(IXPa0YM1PCA-R0nw^qπU"I+>.pFYn41-JWrT^0Z3AY$(;vIkMlHJdMbrSJRut6go4,%*>nvu%EQ.D(ggOiLzπU"t0x15DdkI:j#sg2so?8q]Q5Quv_tNG6p'GZwVb(t6vj,(O&xgz$RK2L6tu&?S5iπU"PWjAFZt?EU$syA4:KCNiko#msadNxRH3whj&\84#]w:/5o=n<1MBU:j2\fkuefbπU"/A#t<SFW-?RBGTqM-EK#geJ^ozw,C:S^q&,<PW*%Bh,5a(^ga61K*jknO4nGhq1πU"F8auEMsnt%LdPnhb+X?ltRo(EBiSkOs8lgsZjSmKUmP*RG\[gG826V,126TC6AHπU"-CmAHp/#o=IngGSbBMt5ubKCkfCs1_(cqfdp\I.cLX9RuZtL;b.VJj[OAM,DK8>πU"co'DFS4&pI,xYe;QXFpTh'X5NBE.M;yA:1W,N(0RSPre<X;cqj0,0R>[tj;0B)>πU"[[MqR7-DB4i%$^[=-O?loo)d\K,F&/,;A<=^#A+?kU5P*LFF/;0ADg#Tk,_U<uPπU"2F_N/owlYPNX6dnBFn=n<o/>dr2=.[4=)EI>b0[*P(2-JG9SxK*2ceC-s<CrfTIπU"c8-x&zIy*mmCu:5vH7vd%z7O-cmpD%q'oyS,2RqjO9NqQD:?LUIu^0]_*Pa7+X'πU"lHWW=te_re4/_w8ZKNy\V&o#v,C2i1jC0a3jWJKQ[:tWFj9EoAW2.'M-oB'Cl<;πU"^0cdK0^Br;2+i&gQaKp0^B;Y2+ig%QaK0##r;aEWecS5+Z^ra:wUF%-?-8VTtlSπU"\gYFgR,zOj..Iv%9S0$-5'S;h8+8tl-<uQJWRRwwFxCwaObS.hN755.5h75kV.hπU"75gK.h7J5+.hK7Sc.hlP5GM-lP5=-(Ges8.(GP/VR'p<v(GY/V<'>]EhP#wGFa'πU"6U2WOT\>IaRE/rcEb>w'6F[BRTqkPAKG'h/x55n.&V\M=1x6IRqBvopf,sE1_tMπU"52Z95eZ&f>qV)t)H<-sC3TOg-S32G\dJ-kNpg)Nyjsc8MQR^zG)$DJpW_(u&xIJπU"A\putHiBpWM8<=49i(=Tq0;jqGOuduoTwFMRjGVEhlc9puu<%up()%9%%%[-%a1πU"7:Dfa4XaM,%%%IT%%%.%%%%xj%yzuS[gfx^h)*>T.[9M\HYxewqHWJ-78JD<5pfπU"/$mo#E.sbTbf/t5)ROZc(lG1(nNLzn)oaeX+em,1QhR>jVG\]S9fEe48YpKq7l,πU"$[^apan;>,7g]8Aq\#r*bG_LBM_Fc$V[<F??brx[W]_/b)Fk,CVl56gc6W#lL^cπU"5;/&Q_fS*P0rR]WrAz\CHC=is6/[tJcW4Gn9HeUDl=bOA>dX$nEgSe3)CEF=U>_πU"qw3RbF<$68oR8SA;xkU*zFEQ5SG&0Z]u0)VjY#f%pjp9B,ScLF,j[qvr:KpF[>MπU"J<WjnUte%>CdGp5f4tnOgC(GT'V,RVZKRD(qxd:%ZEMchp<+&uU2ppDjRe5g+>/πU"]Pn<[eQP_n<3?VvvlPldzerR*9wm#fP;V(-E?Z\0HnC*U3/?q,O-07%USX?<ILcπU"lwWiVFj0SEtP9+\?1b=G?_,mR?h8IRC/(WXFj4]U=GQ_'bK/G[TEXp-K,J1<fE;πU"EDU-'ohwZTtQ4#-?ulDc+]_E2=rY+(/59(8'kU892$tJYNBb7.R'Om^cZP4[dA/πU"\#ROHk_kLtMA-[CZ#$V6SX^PmE^]TtR+K][q-G=*iwS2pEc$3_mP=fm;JEtNdb0πU"FmOZ9Y$VD$M0KvgeU;Qn,1)z-\uV]F(WURSQIE.GMH9TC.k^,4ZIZ.)gq6eLijdπU"fj+:($Rqm&?D=]F;c0S:LurIV)i2YV:z.u>OO;+P>AAc1Kv%gYvX)]p]eWU-(30πU"_JEk>#--P6f;&SbHNO,MnFz<9,6pA5>Lp(%+[L#?tP]fsWjZFXhwx,:grNcQ1G>πU"Lt13-KVHKv)m8=\am(u?C=CS*xXq_JE55&ps'q_3<EiRl#p_7jpQ]m^a&dz]9_=πU"fUIIW+i6]a-1-GdG?jp(0[Q8;il)Wcsc81f^9r7eata9VC,C8*]$KD\i+qhZ^exπU"5/x7YZG]OW/=*B[m6?N[O-Ci[MKbh>k9$j%\KxLX3M\VQp3b_?cND#oflrI'(N,πU"*jZf6[5-1fyHHK6ikrO7qY\T]29']B*aP()Knu3h6BHgPGoX5GRI^m&UXKB/R*tπU"J&R;^=[Gg,*Q]ps>pTP6>F25N']G5ue5iA3jsHNeDf%U)T8Xp7=6AM7*V/]^\34πU"Ri,6Rj$*O;2GCE:58;bFRXk-I,&RkTWQl(q/)Y)pwK(yCK*Fa3;==2KA)cfwV]jπU"ji$kS<I$Vdf''%Ia3ae>xY?hQ/C\j')ssMnJ>zhy7+B^dDT6ZFO&*]/4(x>2rIvπU"5\w\aYN0SQhXP?aiG?1UVjY*2M^]&fuh/[UIh]C8%'<KD-;*tH91Ut5_]l?:PTRπU"V?-eN-S0EcO#$QzT6ZnSx'[[X+oocUYm-Rmh]Nm9PcTs3Yu7yZ>7?BfO:OnJA^AπU"N6Xm\*t<fJ2T5Cn/T_i>k6J:r0tJSMBRpN[r6OR,D,q;R>jXBN;J*$B9e)U1OPXπU"-.qzQ[1G7z7;'W9wFJaEQ&]Of<(6Cz.MIWov+oIl)ALz'yT\mKdUNA:wCA\9V.HπU"z]l/Y(aO7lI>FLnd2ai[os>Cvh>CauKeHtDuQC?7HkBa0J&nkT7>%_Fm+Zmus;hπU"(<KLhnG8YtI%D=4X-WG8[f&dp9WG1*?ZiLiE5fFbI3YPnCEGZP=13I%0gbKh#h+πU"b7R%djTm:*;paFWgX2?aa'\(vI5.$*5jC3pm=1h^6Z[+[hXp6o$L/)(*fTpxaN1πU"uA/p#=.+[qSws9%KU?1.=21*eQ:M+WNE\ybpPPK1%5X+eOZ5.F+9*5Bg(dw2Z/LπU"NoL%15FA'>Ht8js8[z1veZUDWo&)VmIU%EaxF#5,B-rXz1W,,i0sR?E&LOU9tBoπU"TOU_*_1_hPapUi7m39EoVnU/0whM*PH+G=u'kqgio+\K.6PA)T6F'Z^s'R(-cZlπU"#<6M:&]CGu0OALiGo%^aq)418ua9*1>VaAjtr3a9lj1VaT962Vca9V2>Va9v#N:πU"B,=jJJvR5B)CE^4pt3c_Y9;'DCjF/%Zt.G*x3AhmfY)r]mf/i(Y9N*OxeUC?Pb%πU"p4MzBKwkq+ac/;.Ia90^;sac%/;Ib&9/;I(e0QiC:^iE'MvOUCI_wxJeM+r)sz9πU"m(7)Gn+mZzKLo37'u;CI)MQdp0[&Ph<KszUUE^z1\(iX93*D&NAbe(w1/id$M>$πU";Na/YiX9-'_xI1os?Z'(GvG2TzH:&X7NAbu$w1oq,CiNeX,IhkBI*GS$^nQHHf]πU"$;Hs*Yzi5YG,/CsK#PT>mC^:'bCC3DTpfY$^#Nl',EjTDQVFe;,Lk##*h^7V:T+πU"#T;Ng-OYJ?K-58Q?r%n4,'r.Y/?'S,',-PWzM,-(bQh.reu3rcz9%bC2;QGJ#G'πU"P'[\7?c9j&<W?TeWrkB1NO=Ec8d?=[>TAQmD<Ra-hbyRKfCcS74oB,jJaRKonfBπU"t/oyMuG1(q5pTq<\/h-8[PS8Qo8bBbvk\q_t%dup(%)/%%[%%%Y\Y;D5(u(h-%%πU"%%-%%%%0#%%%&Iuz))%qjSh%klUQ%\QZU%2/up%()9%%%%-%($Y;Df.wBR%m&%%πU"%-'%%%0%%%A&uz)&)qjS#ithDk$D:\mU5?h++x4D:^fIwh)7>RdI9f7h7E(A2<1πU"\H^v(8mqWjwn(BJ0pm4:3bPJu5StnHX$fP:-wG;04:%A^KLm&<llE3yPLNv<,QAπU"-g<h1,Y[h2cLsC>(IL#M2_7_Mg1:##MDDm3L+2R1,ksEEJ$fDoN^HAYe:hhf<yrπU"2l,rLLoEyX9.sgn)=S-7=X[Ss:3*8emUw1D7H>)o&Lw&RtU1%Wx22o_l5m:40kfπU"$.i%29Xm4k]C5-fUNg%L69sXUML-CXxI<3SlcrkH7UtL4sE4nf7E]'[=JKTNoR*πU"^z<)cQx_Ta.NyS1j&Jt04V%j]M\[JgbqwJb>wX6,oHY_*?par1Kv.3[Wk^8?O$GπU"D.Uw%P2o4Ihd?csu/A:o>jJMAM#o]u1'SmMRr$l-Hgj;3YDYZdDj-3s)u%p&'9%πU"%9%%%%-%^\X;DNIo=DV[5%%H&#%%0%%%%%%%%%&%%E%%%%%%%(%&uz)))qj%SgfπU"x%up&'%9%9%%%%-%+a1:D]faXa&M,%%%IT%%%.%%%%%%%%%&%E%7%%)5%%%xj%yπU"zuS%gfxu%p&'9%%/%%[%%%Y\Y;D5(u(h-%%%%-%%%%0%%%%%%%%%&%%E%%%%z=%πU"(%&uz)))qj%Shkl%up&'%9%9%%%%-%($Y;Df.wBR%m&%%%-'%%%0%%%%%%%%%&%πU"E%.%%U=.%%&u1z))q%jSit%hup*%+%%%%%)%)+%[%%+%p>%%%%%πEND SUBπCLOSE:IF S=122AND B&=Z&THEN?" :) Ok!"ELSE?" :( Bad!πSUB U(A$):FOR A=1TO LEN(A$):C=ASC(MID$(A$,A))-37:IF C<0THEN C=91+C*32πIF K<4THEN K=C+243ELSE?#1,CHR$(C+(K MOD 3)*86);:K=K\3:B&=B&+1πS=(S+C)AND 255:NEXT:LOCATE,1:?STRING$(B&*50\Z&,219);:END SUBπJustin Pasher                  DUMP OUTBOUND.HIS TO TEXT FILE FidoNet QUIK_BAS Echo          02-07-96 (16:11)       QB, PDS                292  9748     FDHIS.BAS   '-> I'm kinda new to this echo, so hopefully someone will have anπ'-> answer.  Does anyone have the format for FrontDoor 2.20'sπ'-> outbound.his history file?  If so please post it for me.ππ' Try this code out. It works fine for my FD 2.02. I believe the formatsπ'stayed the same. Enjoy! You must load QB.LIB on the command line.ππDECLARE FUNCTION Cvt2Str$ (Value!)πDECLARE FUNCTION DayOfYear! (Month AS INTEGER, Day AS INTEGER, Year AS INTEGER)πDECLARE FUNCTION CurrDay! ()πDECLARE FUNCTION FindFirst! (FileSpec$)πDECLARE FUNCTION FindNext! ()πDECLARE FUNCTION LeapYear! (Year AS INTEGER)πDECLARE FUNCTION Pad$ (tString AS STRING, Spaces AS INTEGER)πDECLARE SUB Check ()πDECLARE SUB GetFileNames ()πDECLARE SUB Header ()π' History Converter v1.1π' Converted from Pascal by Justin Pasherπ'π' Converts the FrontDoor history files to a textfile.π'π'   The first record in the .HIS files is not a valid history entry. Itπ'   contains the date/time when the .HIS file was last packed or whenπ'   it was created if it has never been packed. So if you're readingπ'   the .HIS files for any reason, skip the first record and you'll beπ'   at the first valid record.ππ'$INCLUDE: 'QB.BI'πDIM SHARED Regs AS RegTypeπDIM SHARED RegsX AS RegTypeXπCONST Revision = "1.0"  ' version numberπCONST False = 0πCONST True = NOT FalseπCOMMON SHARED FDenv$, Quantity, NumFiles, Head, NoCallersπON ERROR GOTO 1000ππ' ****** Pascal structureπ'    Year,                     { 1990-xxxx }π'    Month,                    { 1-12 }π'    Day,                      { 1-31 }π'    Hour,                     { 0-23 }π'    Minute,                   { 0-59 }π'    Second,                   { 0-59 }π'    Zone,                     { Zone Number }π'    Net,                      { Net Number  }π'    Node,                     { Node Number }π'    Point     : WORD;π'    SystemName: STRING[30];π'    Location  : STRING[38];π'    TimeOnLine: WORD;         { Seconds spent on-line }π'    RcvdBytes,π'    SentBytes : LONGINT;π'    Cost      : WORD;ππTYPE MailHistTypeπ    Year AS INTEGER           ' 1990-xxxxπ    Month AS INTEGER          ' 1-12π    Day AS INTEGER            ' 1-31π    Hour AS INTEGER           ' 0-23π    Minute AS INTEGER         ' 0-59π    Second AS INTEGER         ' 0-59π    Zone AS INTEGER           ' Zone Numberπ    Net AS INTEGER            ' Net Numberπ    Node AS INTEGER           ' Node Numberπ    PointNum AS INTEGER       ' Point (if applicable)π    SNameLen AS STRING * 1π    SystemName AS STRING * 30 ' System Nameπ    LocLen AS STRING * 1π    Location AS STRING * 38   ' Locationπ    TimeOnline AS INTEGER     ' Seconds spent on-lineπ    RcvdBytes AS LONGπ    SentBytes AS LONGπ    Cost AS INTEGERπEND TYPEπDIM SHARED MailHist AS MailHistTypeππTYPE SearchTypeπ    DosJunk      AS STRING * 21π    Attr         AS STRING * 1π    Time         AS INTEGERπ    Date         AS INTEGERπ    Size         AS LONGπ    FileName     AS STRING * 13πEND TYPEπDIM SHARED Search AS SearchTypeππDIM SHARED His(1 TO 25) AS STRING * 12ππ  CLSπ  RegsX.AX = &H1A00π  RegsX.DS = VARSEG(Search)    'Set DTA Buffer for FindFirst & FindNextπ  RegsX.DX = VARPTR(Search)π  CALL InterruptX(&H21, RegsX, RegsX)π  PRINTπ  PRINT "  FrontDoor History convertor (revision "; Revision; ")."π  PRINT "  A stupid program from and copyrighted by :"π  PRINT "           Gé Janssen, 2:284/134@Fido and Helmut Kicken, 2:284/701@Fido"π  PRINT : PRINT "  Converted to QB by Justin Pasher": PRINTππ  '******** Get FD directoryπ  Path$ = ENVIRON$("FD")π  IF Path$ <> "" THENπ    Path$ = UCASE$(Path$)π    IF RIGHT$(Path$, 1) = "\" THEN FDenv$ = Path$ ELSE FDenv$ = Path$ + "\"π  ELSEπ    PRINT "  No FD environment setting found."π    PRINT "  Example:  C:\FD>SET FD=C:\FD"π    SYSTEMπ  END IFπ  NoCallers = Trueπ  GetFileNamesπ  OPEN FDenv$ + "HISTORY.TXT" FOR OUTPUT AS #2π  FOR NumFiles = 1 TO Quantityπ    OPEN FDenv$ + His(NumFiles) FOR RANDOM AS #1 LEN = LEN(MailHist)π    Checkπ    IF Head = True THEN PRINT #2, ""π    CLOSE #1π    Head = Falseπ  NEXTπ  IF NoCallers = True THEN PRINT "  There was no activity today."π  CLOSE #2π  PRINT "  "; FDenv$; "HISTORY.TXT is now complete!"π  SYSTEMππ1000 IF ERR = 6 THEN RESUME NEXTππSUB Checkπ  DIM SendTot AS LONG    ' total send bytesπ  DIM RcvdTot AS LONG    ' total received bytesπ  DIM TimeTot AS LONG    ' total connect timeπ  Empty = True           ' if no calls (true) then write no callersπ  GET #1, , MailHist     ' dummy readπ  IF LOF(1) = 102 THEN EXIT SUBπ  DOπ    Text$ = ""π    GET #1, , MailHistπ    IF NOT Head THENπ Headerπ Head = Trueπ Foot = Trueπ NoCallers = Falseπ    END IFπ    Empty = Falseπ    IF MailHist.Hour < 10 THEN Text$ = "0"π    Text$ = Text$ + LTRIM$(STR$(MailHist.Hour)) + ":"π    IF MailHist.Minute < 10 THEN Text$ = Text$ + "0"π    SysName$ = LEFT$(MailHist.SystemName, ASC(MailHist.SNameLen))π    Text$ = Text$ + LTRIM$(STR$(MailHist.Minute)) + " " + SysName$π    FOR A = LEN(RTRIM$(SysName$)) TO 29π Text$ = Text$ + " "π    NEXTπ    IF MailHist.SentBytes = 0 THENπ Text$ = Text$ + "N/A       "π    ELSEπ Text$ = Text$ + Pad$(LTRIM$(STR$(MailHist.SentBytes)), 10)π    END IFπ    SendTot = SendTot + MailHist.SentBytesπ    IF MailHist.RcvdBytes = 0 THENπ Text$ = Text$ + "N/A        "π    ELSEπ Text$ = Text$ + Pad$(LTRIM$(STR$(MailHist.RcvdBytes)), 11)π    END IFπ    RcvdTot = RcvdTot + MailHist.RcvdBytesπ    Minutes = MailHist.TimeOnline \ 60π    Seconds = MailHist.TimeOnline MOD 60π    TimeTot = TimeTot + MailHist.TimeOnlineπ    IF Minutes < 10 THEN Text$ = Text$ + "0"π    Text$ = Text$ + Cvt2Str$(Minutes) + ":"π    IF Seconds < 10 THEN Text$ = Text$ + "0"π    Text$ = Text$ + Cvt2Str$(Seconds) + "   (" + LTRIM$(STR$(MailHist.Zone)) + ":" + LTRIM$(STR$(MailHist.Net)) + "/" + LTRIM$(STR$(MailHist.Node))π    IF MailHist.PointNum <> 0 THENπ Text$ = Text$ + "." + LTRIM$(STR$(MailHist.PointNum))π    END IFπ    Text$ = Text$ + ")"π    PRINT #2, Text$π  LOOP UNTIL EOF(1)π  IF Empty = False THENπ    PRINT #2, "────────────────────────────────────────────────────────────────────────────"π    PRINT #2, "Totals bytes sent: "; Pad$(LTRIM$(STR$(SendTot)), 36); "Total bytes received: "; Pad$(LTRIM$(STR$(RcvdTot)), 9)π    Hours = TimeTot \ 3600π    Minutes = TimeTot MOD 3600 \ 60π    Seconds = TimeTot MOD 3600 MOD 60π    Text$ = "Total Time: "π    Text$ = Text$ + Cvt2Str$(Hours) + ":"π    IF Hours < 10 THEN Text$ = " 0" + Text$π    IF Minutes < 10 THEN Text$ = Text$ + "0"π    Text$ = Text$ + Cvt2Str$(Minutes) + ":" + Cvt2Str$(Seconds)π    PRINT #2, Text$π    PRINT #2, ""π    PRINT #2, ""π  END IFπEND SUBππFUNCTION CurrDay!π  DIM Month AS INTEGERπ  DIM Day AS INTEGERπ  DIM Year AS INTEGERπ  Month = VAL(LEFT$(DATE$, 2))π  Day = VAL(MID$(DATE$, 4, 2))π  Year = VAL(RIGHT$(DATE$, 4))π  A = DayOfYear(Month, Day, Year) - 1π  IF A = 0 THENπ    IF LeapYear(Year - 1) THEN CurrDay! = 366 ELSE CurrDay! = 365π  ELSEπ    CurrDay! = Aπ  END IFπEND FUNCTIONππFUNCTION Cvt2Str$ (Value)π  Cvt2Str$ = LTRIM$(STR$(Value))πEND FUNCTIONππFUNCTION DayOfYear (Month AS INTEGER, Day AS INTEGER, Year AS INTEGER)π  IF LeapYear(Year) THEN N = 1 ELSE N = 2π  N = 275 * Month \ 9 - N * ((Month + 9) \ 12) + INT(Day) - 30π  DayOfYear = NπEND FUNCTIONππFUNCTION FindFirst (FileSpec$)π  Spec$ = FileSpec$ + CHR$(0)π  DIM DateTime(6)π  RegsX.AX = &H4E00π  RegsX.CX = Attrπ  RegsX.DS = VARSEG(Spec$)π  RegsX.DX = SADD(Spec$)π  CALL InterruptX(&H21, RegsX, RegsX)π  Ecode = RegsX.AXπ  IF Ecode GOTO NoMoreπ  F$ = Search.FileNameπ  Null = INSTR(F$, CHR$(0))π  IF Null THEN Search.FileName = LEFT$(F$, Null - 1)πNoMore:π  IF Ecode = 2 OR Ecode = 18 THEN FindFirst = False ELSE FindFirst = TrueπEND FUNCTIONππFUNCTION FindNextπ  DIM DateTime(6)π  RegsX.AX = &H4F00π  CALL InterruptX(&H21, RegsX, RegsX)π  Ecode = RegsX.AXπ  IF Ecode GOTO NoMore2π  F$ = Search.FileNameπ  Null = INSTR(F$, CHR$(0))π  IF Null THEN FileName$ = LEFT$(FileName$, Null - 1)πNoMore2:π  IF Ecode = 2 OR Ecode = 18 THEN FindNext = False ELSE FindNext = TrueπEND FUNCTIONππSUB GetFileNamesπ  RC = FindFirst(FDenv$ + "*.HIS")π  IF RC = False THEN PRINT "No *.HIS file(s) not found": EXIT SUBπ  Quantity = 1π  DOπ    FileName$ = UCASE$(RTRIM$(Search.FileName))π    His(Quantity) = FileName$π    IF ASC(RIGHT$(His(Quantity), 1)) = 0 THEN His(Quantity) = LEFT$(His(Quantity), LEN(His(Quantity)) - 1)π    Quantity = Quantity + 1π    RC = FindNextπ  LOOP UNTIL RC = False OR Quantity = 25π  Quantity = Quantity - 1πEND SUBππSUB Headerπ  Month = VAL(LEFT$(DATE$, 2))π  Day = VAL(MID$(DATE$, 4, 2))π  Year = VAL(RIGHT$(DATE$, 4))π  IF LEFT$(His(NumFiles), 1) = "I" THENπ    PRINT #2, "Inbound Mail/Fax/BBS callers history "π  ELSEπ    PRINT #2, "Outbound Mail/Fax/BBS callers history "π  END IFπ  Text$ = "(" + RTRIM$(His(NumFiles)) + ") from "π  IF Month < 10 THEN Text$ = Text$ + "0"π  Text$ = Text$ + Cvt2Str$(Month) + "-"π  IF Day < 10 THEN Text$ = Text$ + "0"π  Text$ = Text$ + Cvt2Str$(Day) + "-" + Cvt2Str$(Year) + "."π  PRINT #2, Text$π  PRINT #2, ""π  PRINT #2, "Time  System Sent                   Sent      Rcvd      Duration Node Number"π  PRINT #2, STRING$(79, "─")π  PRINT "  Reading "; FDenv$; His(NumFiles)πEND SUBππFUNCTION LeapYear (Year AS INTEGER)π  IF ((Year MOD 100) <> 0) AND ((Year MOD 4) = 0) THEN LeapYear = True ELSE LeapYear = FalseπEND FUNCTIONππFUNCTION Pad$ (tString AS STRING, Spaces AS INTEGER)π  IF LEN(tString) > Spaces THEN Pad = LEFT$(tString, Spaces): EXIT FUNCTIONπ  Pad = tString + STRING$(Spaces - LEN(tString), " ")πEND FUNCTIONπDouglas H. Lusher              LED CLOCK DISPLAY              FidoNet QUIK_BAS Echo          03-23-96 (15:23)       QB, QBasic, PDS        200  5604     LED.BAS      DECLARE SUB ClrRowCtrMsg (Message$)π DECLARE SUB LED1 (Spec$)π DECLARE SUB LED2 (Spec$)π DEFINT A-Zππ 'GOTO Clockππ SCREEN 0, 1, 0: COLOR 7, 1: CLSπ COLOR 0, 1π LOCATE 3, 6: PRINT STRING$(69, "▄")π FOR R% = 4 TO 8    'change 8 to 10 for large LEDsπ   LOCATE R%, 6: PRINT STRING$(69, "█");π NEXTππ DOπ   T$ = "  0:00:00"π   LOCATE 4, 7: COLOR 7, 0: CALL LED1(T$): COLOR 7, 1π   ClrRowCtrMsg "Press any key to begin timing..."π   X$ = INPUT$(1)π   Start! = TIMERπ   ClrRowCtrMsg "Press any key to stop timer..."π   DOπ     GOSUB ShowTimeπ     X$ = INKEY$: IF LEN(X$) THEN EXIT DOπ   LOOPπ   ClrRowCtrMsg "Press ESC to quit, any other key to reset the timer."π   X$ = INPUT$(1): IF X$ = CHR$(27) THEN EXIT DOπ LOOPπ CLSπ ENDππ ShowTime:π T! = TIMER - Start!π Mins$ = RIGHT$("  " + STR$(INT(T!) \ 60), 3)π Secs$ = RIGHT$(STR$((INT(T!) MOD 60) + 100), 2)π Frac$ = MID$(STR$(T! - INT(T!)) + "00", 3, 2)π MID$(T$, 1, 3) = Mins$: MID$(T$, 5, 2) = Secs$: MID$(T$, 8, 2) = Frac$π LOCATE 4, 7: COLOR 7, 0: CALL LED1(T$): COLOR 7, 1π RETURNππ Clock:π SCREEN 0, 1, 0: COLOR 7, 1: CLSπ COLOR 0, 1π LOCATE 3, 10: PRINT STRING$(60, "▄")π FOR R% = 4 TO 8    'change 8 to 10 for large LEDsπ   LOCATE R%, 10: PRINT STRING$(60, "█");π NEXTπ COLOR 7, 0π DO UNTIL LEN(INKEY$)π   LOCATE 4, 11: CALL LED1(TIME$)π LOOPπ CLSπ ENDππ SUB ClrRowCtrMsg (Message$)π LOCATE 12, 1: PRINT SPC(79); " ";π LOCATE , (82 - LEN(Message$)) \ 2: PRINT Message$;π END SUBππ SUB LED1 (Spec$) STATICππ IF Initialized% GOTO Begin1π Top1$ = "▄▀▀▀▀▄"π Top2$ = "▄    ▄"π Top3$ = "     ▄"π Top4$ = "▄     "π Top5$ = " ▀▀▀▀▄"π Top6$ = "▄▀▀▀▀ "π Bot1$ = " ▀▀▀▀ "π Ctr2$ = "█    █"π Ctr3$ = "     █"π Ctr4$ = "█     "π XXX1$ = "      "π Initialized% = -1ππ Begin1:π R% = CSRLIN: C% = POS(0)π FOR Ptr% = 1 TO LEN(Spec$)π  SELECT CASE ASC(MID$(Spec$, Ptr%, 1))π    CASE 48π      T$ = Top1$: C1$ = Ctr2$: M$ = Top2$: C2$ = Ctr2$: B$ = Bot1$π      GOSUB ShowChar1: C% = C% + 9π    CASE 49π      T$ = Top3$: C1$ = Ctr3$: M$ = Top3$: C2$ = Ctr3$: B$ = XXX1$π      GOSUB ShowChar1: C% = C% + 9π    CASE 50π      T$ = Top5$: C1$ = Ctr3$: M$ = Top6$: C2$ = Ctr4$: B$ = Bot1$π      GOSUB ShowChar1: C% = C% + 9π    CASE 51π      T$ = Top5$: C1$ = Ctr3$: M$ = Top5$: C2$ = Ctr3$: B$ = Bot1$π      GOSUB ShowChar1: C% = C% + 9π    CASE 52π      T$ = Top2$: C1$ = Ctr2$: M$ = Top5$: C2$ = Ctr3$: B$ = XXX1$π      GOSUB ShowChar1: C% = C% + 9π    CASE 53π      T$ = Top6$: C1$ = Ctr4$: M$ = Top5$: C2$ = Ctr3$: B$ = Bot1$π      GOSUB ShowChar1: C% = C% + 9π    CASE 54π      T$ = Top4$: C1$ = Ctr4$: M$ = Top1$: C2$ = Ctr2$: B$ = Bot1$π      GOSUB ShowChar1: C% = C% + 9π    CASE 55π      T$ = Top5$: C1$ = Ctr3$: M$ = Top3$: C2$ = Ctr3$: B$ = XXX1$π      GOSUB ShowChar1: C% = C% + 9π    CASE 56π      T$ = Top1$: C1$ = Ctr2$: M$ = Top1$: C2$ = Ctr2$: B$ = Bot1$π      GOSUB ShowChar1: C% = C% + 9π    CASE 57π      T$ = Top1$: C1$ = Ctr2$: M$ = Top5$: C2$ = Ctr3$: B$ = XXX1$π      GOSUB ShowChar1: C% = C% + 9π    CASE ASC(":")π      LOCATE R% + 1, C%: PRINT "▀";π      LOCATE R% + 3, C%: PRINT "▀";π      C% = C% + 3π    CASE 32π      T$ = XXX1$: C1$ = XXX1$: M$ = XXX1$: C2$ = XXX1$: B$ = XXX1$π      GOSUB ShowChar1: C% = C% + 8π  END SELECTπ NEXTπ EXIT SUBππ ShowChar1:π LOCATE R% + 0, C%: PRINT T$;π LOCATE R% + 1, C%: PRINT C1$;π LOCATE R% + 2, C%: PRINT M$;π LOCATE R% + 3, C%: PRINT C2$;π LOCATE R% + 4, C%: PRINT B$;π RETURNπ END SUBππ SUB LED2 (Spec$) STATICππ IF Initialized% GOTO Begin2π Top1$ = "▄▀▀▀▀▀▄"π Top2$ = "▄     ▄"π Top3$ = "      ▄"π Top4$ = "▄      "π Top5$ = " ▀▀▀▀▀▄"π Top6$ = "▄▀▀▀▀▀ "π Bot1$ = " ▀▀▀▀▀ "π Ctr2$ = "█     █"π Ctr3$ = "      █"π Ctr4$ = "█      "π XXX1$ = "       "π Initialized% = -1ππ Begin2:π R% = CSRLIN: C% = POS(0)π FOR Ptr% = 1 TO LEN(Spec$)π  SELECT CASE ASC(MID$(Spec$, Ptr%, 1))π    CASE 48π      T$ = Top1$: C1$ = Ctr2$: M$ = Top2$: C2$ = Ctr2$: B$ = Bot1$π      GOSUB ShowChar2: C% = C% + 9π    CASE 49π      T$ = Top3$: C1$ = Ctr3$: M$ = Top3$: C2$ = Ctr3$: B$ = XXX1$π      GOSUB ShowChar2: C% = C% + 9π    CASE 50π      T$ = Top5$: C1$ = Ctr3$: M$ = Top6$: C2$ = Ctr4$: B$ = Bot1$π      GOSUB ShowChar2: C% = C% + 9π    CASE 51π      T$ = Top5$: C1$ = Ctr3$: M$ = Top5$: C2$ = Ctr3$: B$ = Bot1$π      GOSUB ShowChar2: C% = C% + 9π    CASE 52π      T$ = Top2$: C1$ = Ctr2$: M$ = Top5$: C2$ = Ctr3$: B$ = XXX1$π      GOSUB ShowChar2: C% = C% + 9π    CASE 53π      T$ = Top6$: C1$ = Ctr4$: M$ = Top5$: C2$ = Ctr3$: B$ = Bot1$π      GOSUB ShowChar2: C% = C% + 9π    CASE 54π      T$ = Top4$: C1$ = Ctr4$: M$ = Top1$: C2$ = Ctr2$: B$ = Bot1$π      GOSUB ShowChar2: C% = C% + 9π    CASE 55π      T$ = Top5$: C1$ = Ctr3$: M$ = Top3$: C2$ = Ctr3$: B$ = XXX1$π      GOSUB ShowChar2: C% = C% + 9π    CASE 56π      T$ = Top1$: C1$ = Ctr2$: M$ = Top1$: C2$ = Ctr2$: B$ = Bot1$π      GOSUB ShowChar2: C% = C% + 9π    CASE 57π      T$ = Top1$: C1$ = Ctr2$: M$ = Top5$: C2$ = Ctr3$: B$ = XXX1$π      GOSUB ShowChar2: C% = C% + 9π    CASE ASC(":")π      LOCATE R% + 1, C%: PRINT "▄";π      LOCATE R% + 4, C%: PRINT "▄";π      C% = C% + 3π    CASE 32π      T$ = XXX1$: C1$ = XXX1$: M$ = XXX1$: C2$ = XXX1$: B$ = XXX1$π      GOSUB ShowChar2: C% = C% + 9π  END SELECTπ NEXTπ EXIT SUBππ ShowChar2:π LOCATE R% + 0, C%: PRINT T$;π LOCATE R% + 1, C%: PRINT C1$;π LOCATE R% + 2, C%: PRINT C1$;π LOCATE R% + 3, C%: PRINT M$;π LOCATE R% + 4, C%: PRINT C2$;π LOCATE R% + 5, C%: PRINT C2$;π LOCATE R% + 6, C%: PRINT B$;π RETURNπ END SUBπEthan Winer                    INSTALLATION UTILITY           [e-mail]   01-29-93 (10:58)       QB, PDS                1067 39535    PC-SETUP.BAS'********** PC-SETUP.BAS - PC Magazine Install Utilityππ'Copyright (c) 1992 Ethan Winerππ'Note: If you run this program in the QB editor the ExeName function willπ'return the directory that QB.EXE was run from, which is not necessarily theπ'current directory.  In that case you may have to enter the directory nameπ'where your various .ZIP files reside for PC-SETUP to find them.π'π'If you are using Crescent's P.D.Q. you must search for all each call to theπ'Interrupt routine, and change it as shown in the accompanying comments.  Youπ'can then compile and link this program for the smallest size possible asπ'follows:π'π'   bc pc-setup /o/s;π'   link /nod/noe/packc/far/ex _π'     pc-setup _noread _noval _noerror _cprint , , nul , [basic7] pdq;π'   exe2com pc-setup               (optional)π'   del pc-setup.exe               (optional)π'   ren pc-setup.com pc-setup.exe  (optional)πππDEFINT A-Zππ'---- BASIC SUB and FUNCTION procedures in this program fileπ'πDECLARE SUB CopyFile (Source$)πDECLARE SUB DrawBox (ULRow, ULCol, LRRow, LRCol, Style)πDECLARE SUB DrawScreen ()πDECLARE SUB Editor (Text$, Row, LeftCol, Length, KeyCode)πDECLARE SUB EarlyEnd ()πDECLARE SUB ErrorEnd (Message$)πDECLARE SUB MidCharS (Work$, Position, NewChar)πDECLARE SUB ReadNames (Spec$, Array$())πDECLARE SUB SelectFiles (FileNames$(), Choice, ExitCode)πDECLARE SUB SetDrive (Drive$)πDECLARE SUB StuffBuf (Work$)ππDECLARE FUNCTION ChangeDir% (DirName$)πDECLARE FUNCTION DOSVersion% ()πDECLARE FUNCTION Execute% (FileName$, Parameter$)πDECLARE FUNCTION ExeName$ ()πDECLARE FUNCTION FileCount% (FileSpec$, DirFlag)πDECLARE FUNCTION GetComment$ (FileName$)πDECLARE FUNCTION GetDir$ ()πDECLARE FUNCTION GetDrive% ()πDECLARE FUNCTION IntVal% (Work$)πDECLARE FUNCTION MakeDir% (DirName$)πDECLARE FUNCTION MidChar% (Work$, Position)πDECLARE FUNCTION Prompt% (Which)πDECLARE FUNCTION SourceDir$ ()πππ'Define the TYPE and other shared variables needed for using CALL InterruptX.π'πTYPE RegTypeπ  AX    AS INTEGERπ  BX    AS INTEGERπ  CX    AS INTEGERπ  DX    AS INTEGERπ  BP    AS INTEGERπ  SI    AS INTEGERπ  DI    AS INTEGERπ  Flags AS INTEGERπ  DS    AS INTEGERπ  ES    AS INTEGERπEND TYPEπDIM SHARED Regs AS RegTypeππTYPE DTAType                            'used by find first/next serviceπ  Reserved  AS STRING * 21              'reserved for use by DOSπ  Attribute AS STRING * 1               'the file's attributeπ  FileTime  AS STRING * 2               'the file's timeπ  FileDate  AS STRING * 2               'the file's dateπ  FileSize  AS LONG                     'the file's sizeπ  FileName  AS STRING * 13              'the file's nameπEND TYPEπDIM SHARED DTA AS DTATypeππDIM SHARED DOS                          'so the DOS procedures can get at itπDIM SHARED ZBuffer AS STRING * 80       'holds ASCIIZ copies of DOS stringsπDIM SHARED One, Zero, Zero$             'these save code when used in CALLsπDIM SHARED Temp, Temp$                  'these are reusable scratch variablesππ'---- Define some constants and variables, and colors based on display type.π'πCONST MaxFiles% = 19                    'max. number of .ZIP files per diskπCONST DirLength% = 25                   'length of dest. directory displayππOne = 1                                 'saves four bytes per use in a CALLπDOS = &H21                              'also saves four bytes per useπZero$ = CHR$(0)                         'call CHR$() just once hereπPadComment$ = SPACE$(36)                'holds each comment when printingπREDIM DirsMade$(1 TO 100)               'remembers directories we createdππBar$ = "╠" + STRING$(78, 205) + "╣"     'for the main screen separating barsπMsg$ = SPACE$(79)                       'for messages on the bottom lineπIF INSTR(UCASE$(COMMAND$), "/B") THEN MonoFlag = -1   '/b forces mono colorsππNormFG = 11: NormBG = 7                 'assume colors for a color displayπHiFG = 11: HiBG = 4                     'menu and default directory colorsπMainFG = 10: MainBG = 1                 'main screen and box FG and BG colorsπCsrSize = 7                             'color displays use 8 scan linesππDEF SEG = 0                             'see if it's really a color displayπMonoMon = (PEEK(&H463) = &HB4)          'if not, MonoMon now equals -1πIF MonoMon OR MonoFlag THEN             'it's monochrome or /b was usedπ  NormFG = 7: NormBG = 0π  HiFG = 15: HiBG = 0π  MainFG = 0: MainBG = 7π  IF MonoMon THEN CsrSize = 12          'mono displays use 13 scan linesπEND IFππIF DOSVersion% < 300 THEN               'PC-SETUP requires DOS 3.0 or laterπ  PRINT "DOS 3.0 or later required."π  ENDπEND IFππ'---- Get the directory PC-SETUP was run from or prompt for it if needed, toπ'     ensure that there's at least one .ZIP file present to install.π'πInstPath$ = SourceDir$πDOπ  IF RIGHT$(InstPath$, 1) <> "\" THEN InstPath$ = InstPath$ + "\"π  InstSpec$ = InstPath$ + "*.ZIP"π  NumFiles = FileCount%(InstSpec$, Zero)π  IF NumFiles THEN EXIT DOπ  PRINT "No .ZIP files were found."π  INPUT "Enter the source directory or press Enter to end: ", InstPath$π  IF LEN(InstPath$) = 0 THEN ENDπLOOPππIF FileCount%(InstPath$ + "PKUNZIP.EXE", Zero) = 0 THEN 'confirm PKUNZIPπ  PRINT "Can't find PKUNZIP."                           '  is availableπ  ENDπEND IFπ     πIF MidChar%(InstPath$, 2) <> 58 THEN    'if there's no drive letter (:)π  InstPath$ = CHR$(GetDrive%) + ":" + InstPath$ 'append the current driveπEND IFπππ'---- See if they're installing more than one disk, and if so how many.π'πNumDisks = 1                                'assume only one disk for nowπNumDisksFile$ = InstPath$ + "NUMDISKS.*"    'concatenate these just onceππIF FileCount%(NumDisksFile$, Zero) THENπ  DIM NumDisks$(1 TO 1)π  CALL ReadNames(NumDisksFile$, NumDisks$())π  Temp = INSTR(NumDisks$(1), ".")π  NumDisks = IntVal%(MID$(NumDisks$(1), Temp + 1))πEND IFπππ'---- See if there's a DEFAULT.DIR file in the root directory of the firstπ'     distribution disk, and if so read its contents.  Here we're usingπ'     FileCount to merely see if the file exists.  If there's no DEFAULT.DIRπ'     file, default to current drive and directory.  And if the current driveπ'     is A or B replace that with C.π'πSaveDir$ = CHR$(GetDrive%) + ":" + GetDir$      'save this while we have itπDefaultDir$ = SaveDir$                          'now assign it as the defaultππTemp = ASC(DefaultDir$)                         'avoid using ASC() twiceπIF Temp = 65 OR Temp = 66 THEN                  'don't default to A: or B:π  CALL MidCharS(DefaultDir$, 1, 67)             'if A: or B:, substitute C:πEND IFππDefaultDirFile$ = InstPath$ + "DEFAULT.DIR"     'concatenate these just onceππIF FileCount%(DefaultDirFile$, Zero) THEN       'open the file if it existsπ  OPEN DefaultDirFile$ FOR INPUT AS #1π  INPUT #1, DefaultDir$                         'read the default directory,π  CLOSE                                         ' trim and capitalize (UCASE$π  DefaultDir$ = UCASE$(RTRIM$(LTRIM$(DefaultDir$))) ' is for cosmetics only)πEND IFπππ'---- See if there's a PROGRAM.RUN file in the root directory of the firstπ'     distribution disk, and if so read its contents.π'πRunFileName$ = InstPath$ + "PROGRAM.RUN"        'concatenate these just onceπIF FileCount%(RunFileName$, Zero) THEN          'open the file if it existsπ  OPEN RunFileName$ FOR INPUT AS #1π  INPUT #1, RunName$π  CLOSEπ  RunName$ = RunName$ + CHR$(13)                'simulate pressing Enterπ  IF LEN(RunName$) > 15 THEN RunName$ = ""      'don't use name if too longπEND IFπππ'---- This is the main installation loop that cycles through each diskette.π'πFOR Disk = 1 TO NumDisksππ  '---- See how many .ZIP files there are on the current disk, and limit theπ  '     number we'll handle to MaxFiles% if there are more than that.  Thenπ  '     draw/redraw the main screen.π  'π  NumFiles = FileCount%(InstSpec$, Zero)π  IF NumFiles > MaxFiles% THEN NumFiles = MaxFiles%π π  CALL DrawScreenπ π  '---- Read the .ZIP file names and display them in a vertical menu.  Thenπ  '     read any default directories (if present) within each .ZIP file'sπ  '     comment, and display them in the destination directory fields.  Forπ  '     each .ZIP file that doesn't have a corresponding default directoryπ  '     in the comment, use the contents of the main DEFAULT.DIR file foundπ  '     in the root directory of the disk.π  'π  REDIM ZIPName$(1 TO NumFiles)π  REDIM DestDir$(1 TO NumFiles)π  REDIM Comment$(1 TO NumFiles)ππ  CALL ReadNames(InstSpec$, ZIPName$())ππ  FOR X = 1 TO NumFiles                 'look at each .ZIP file commentπ    DestDir$(X) = SPACE$(DirLength%)    'create a string to hold the dest dirπ    LSET DestDir$(X) = DefaultDir$      'assume none, use the global defaultπ    Comment$(X) = GetComment$(InstPath$ + ZIPName$(X))π    Temp = INSTR(Comment$(X), "■")      'see if a directory was givenπ    IF Temp THEN                        'there is a directory for this fileπ      LSET DestDir$(X) = UCASE$(MID$(Comment$(X), Temp + 1)) 'dir is on rightπ      Comment$(X) = LEFT$(Comment$(X), Temp - 1)         'and comment on leftπ    END IFπ  NEXTππ  FOR X = 1 TO NumFiles                 'add leading blanks to make roomπ    ZIPName$(X) = "   " + ZIPName$(X)   '  for the CHR$(251) check marksπ    IF RIGHT$(Comment$(X), 1) = "√" THEN    'they want this file checkedπ      CALL MidCharS(ZIPName$(X), 2, 251)    'so check it in the file list boxπ      Comment$(X) = LEFT$(Comment$(X), LEN(Comment$(X)) - 1)π    END IFπ    LSET PadComment$ = Comment$(X)      'display the directories and commentsπ    COLOR NormFG, NormBG                'while we're hereπ    LOCATE X + 4, 2: PRINT DestDir$(X);π    LOCATE X + 4, 44: PRINT PadComment$;π  NEXTππ  DO                                    'let the user select the filesπ    CALL SelectFiles(ZIPName$(), Choice, ExitCode)π    IF ExitCode = 9 THEN                'they pressed Tabπ      COLOR MainFG, MainBGπ      LOCATE 25, 2π      PRINT SPC(30); "Tab: Select .ZIP files    F2: Begin    Esc: Quit";ππ      DOπ        CALL Editor(DestDir$(Choice), Choice + 4, 2, 25, ExitCode)π        SELECT CASE ExitCode            'how did the terminate editing?π          CASE -80                      'Down Arrowπ            Choice = Choice + 1         'wrap around if they go past the endπ            IF Choice > NumFiles THEN Choice = 1π          CASE -72                      'Up Arrowπ            Choice = Choice - 1         'wrap to the end if they go before 1π            IF Choice < 1 THEN Choice = NumFilesπ          CASE 27                       'Escapeπ            CALL EarlyEndπ          CASE -60                      'F2π            ExitCode = -60              'tell SelectFiles to come right backπ            EXIT DO                     '  so we can exit both levels of DOπ          CASE ELSEπ            EXIT DO                     'anything else returns to SelectFilesπ        END SELECTπ      LOOPπ    ELSEIF ExitCode = -60 THEN          'F2π      ExitCode = 0                      'prevent unwanted recursion acrossπ      EXIT DO                           '  multiple disksπ    ELSEIF ExitCode = 27 THEN           'Escapeπ      CALL EarlyEndπ    END IFπ  LOOPπππ  '---- Install the selected files to the specified destination directories.π  '     For each file that is tagged, either change to the appropriate driveπ  '     and directory, or ensure that we're back to the original path.π  'π  FOR X = 1 TO NumFiles                       'for each .ZIP file presentππ    IF MidChar%(ZIPName$(X), 2) = 251 THEN    'if it's tagged to installππ      IF X = 1 THEN RunProg = -1              'use PROGRAM.RUN only if firstπ                                              '  file is being installedπ      COLOR MainFG, MainBG                    'for the status message belowπ      CLSπ      LSET Msg$ = "Installing" + RTRIM$(MID$(ZIPName$(X), 3)) + "..."π      COLOR HiFGπ      PRINT Msg$                              'advise the user as to progressπ      COLOR MainFGπ     π      DestPath$ = RTRIM$(DestDir$(X))         'work with a copy of the pathππ      IF MidChar%(DestPath$, 2) = 58 THEN     'if a drive was used (58 = ":")π        CALL SetDrive(DestPath$)              'change to that driveπ        IF GetDrive% <> ASC(DestPath$) THEN   'no such driveπ          CALL ErrorEnd("Drive " + LEFT$(DestPath$, 2) + " invalid")π        END IFπ      ELSEπ        CALL SetDrive(DefaultDir$)            'else switch to default driveπ      END IFππ      'strip off possible trailing "\" unless it refers to the root directoryπ      IF RIGHT$(DestPath$, 1) = "\" THENπ        Temp = LEN(DestPath$)π        IF Temp > 1 AND RIGHT$(DestPath$, 2) <> ":\" THENπ          DestPath$ = LEFT$(DestPath$, Temp - 1)π        END IFπ      END IFππ      Temp = -1                               'assume directory now existsπ      IF LEN(DestPath$) THEN                  'if a directory name was givenππ        IF RIGHT$(DestPath$, 1) <> "\" THEN   'and it's not a root directoryππ          IF FileCount%(DestPath$, -1) = 0 THEN   'does the directory exist?π            IF MakeDir%(DestPath$) THEN       'no, so first try to create itπ              CALL ErrorEnd("Cannot create " + DestPath$)π            END IFπ            Temp = 0                          'it can't possibly have filesπ            DirsWeMade = DirsWeMade + 1       'show we created another oneπ            DirsMade$(DirsWeMade) = DestPath$ 'and remember its nameπ          END IFππ          FOR Y = 1 TO DirsWeMade             'see if we made this directoryπ            IF DestPath$ = DirsMade$(Y) THEN  'yes, so there's no need toπ              Temp = 0                        ' warn about overwriting filesπ              EXIT FORπ            END IFπ          NEXTππ        END IFππ        IF ChangeDir%(DestPath$) THEN         'then try to change to itπ          CALL ErrorEnd("Unable to access " + DestPath$)π        END IFππ      END IFππ      PKCmd$ = "-o "                          'assume they want to be warnedπ      IF Temp THEN                            'this directory existedπ        IF Prompt%(Zero) THEN                 'ask if they want to be warnedπ          PKCmd$ = ""                         ' to overwrite existing filesπ        END IF                                ' without further prompting andπ      END IF                                  ' use appropriate command if soππ      IF NOT PKCopied THEN                    'copy PKUNZIP first time onlyπ        PKCopied = -1                         'flag that we did it alreadyπ        CALL CopyFile(InstPath$)              'show where PKUNZIP.EXE isπ        PKDir$ = RTRIM$(DestDir$(X))          'remember where we put it!π        IF LEN(PKDir$) = 0 THEN PKDir$ = DefaultDir$ 'use default dir if noneπ       π        Temp = ASC(RIGHT$(PKDir$, 1))         'check the right-most characterπ        IF Temp <> 58 AND Temp <> 92 THEN     'if not a colon or backslashπ          PKDir2$ = "\"                       ' create a trailing "\"π        END IF                                ' which is appended belowπ      END IFππ      '---- Install all of the files contained in this .ZIP file and checkπ      '     for an errors returned by either DOS or PKUNZIP.  Execute returnsπ      '     positive error values if PKUNZIP was run okay but it returned anπ      '     error via the DOS Errorlevel.  If DOS itself reports an errorπ      '     (perhaps there wasn't enough memory to run the program) Executeπ      '     returns the DOS error value as a negative number.  Error 8 is theπ      '     DOS "Out of memory" error.π      'π      Temp = Execute%(PKDir$ + PKDir2$ + "PKUNZIP.EXE", PKCmd$ + InstPath$ + RTRIM$(MID$(ZIPName$(X), 4)))π      IF Temp THENπ        Temp$ = "PKUNZIP reports Error" + STR$(Temp)π        IF Temp < 0 THEN Temp$ = "Out of memory"π        CALL ErrorEnd(Temp$)π      END IFππ      IF INKEY$ = CHR$(27) THEN         'allow aborting by pressing Escapeπ        CALL EarlyEndπ      END IFππ    END IFππ  NEXTππ  IF Disk < NumDisks THEN               'if there are more disks to installπ    LOCATE 25, 2                        'prompt to insert the next diskπ    LSET Msg$ = "Insert the next disk and press any key when ready"π    COLOR MainFG, MainBGπ    PRINT Msg$;π    LOCATE , 52π    DO: LOOP WHILE LEN(INKEY$)          'first clear any pending keysπ    DO: LOOP UNTIL LEN(INKEY$)          'then wait for a keypressπ    CALL SetDrive(SaveDir$)             'return to the current drive and itsπ    Temp = ChangeDir%(SaveDir$)         '  current directory before going onπ  END IFππNEXT Diskπππ'---- Report success and run the specified program (StuffBuf ignores a nullπ'     string argument.π'πCOLOR 7, 0: CLSπLOCATE 13, 30: PRINT "Installation complete!"πLOCATE 22, 1, 1πCALL SetDrive(PKDir$)                   'change to the first drive andπTemp = ChangeDir%(PKDir$)               ' directory we installed toπKILL "PKUNZIP.EXE"                      'delete the copy of PKUNZIP.EXE thereπIF RunProg THEN CALL StuffBuf(RunName$) 'stuff the buffer if appropriateπEND                                     'and endππFUNCTION ChangeDir% (DirName$)          'returns 0 if Okay, -1 if an errorπ π  ZBuffer$ = DirName$ + Zero$           'make an ASCIIZ stringπ  Regs.AX = &H3B00                      'DOS change directory serviceπ  Regs.DX = VARPTR(ZBuffer$)            'show DOS where ZBuffer$ isπ  CALL Interrupt(DOS, Regs, Regs)       'call DOSπ 'CALL Interrupt(DOS, Regs)             'use this with P.D.Q.ππ  IF Regs.Flags AND 1 THEN              'must be an invalid pathπ    ChangeDir% = -1                     'return -1 as an errorπ  END IFππEND FUNCTIONππSUB CopyFile (Source$) STATIC           'copies PKUNZIP.EXEπ π  Temp$ = Source$ + "PKUNZIP.EXE"π π  IF FileCount%(Temp$, Zero) THENπ    OPEN Temp$ FOR BINARY AS #1         'open the input file if it existsπ  ELSE                                  'if we can't find it, bag out withπ    CALL ErrorEnd("Can't find PKUNZIP.EXE")     ' an error messageπ  END IFππ  OPEN "PKUNZIP.EXE" FOR BINARY AS #2   'now open the target fileππ  Temp$ = SPACE$(LOF(1))                'make a buffer to hold PKUNZIP.EXEπ  GET #1, , Temp$                       'read the source fileπ  PUT #2, , Temp$                       'write it to the destinationπ π  CLOSE                                 'all done hereπ   πEND SUBππFUNCTION DOSVersion% STATIC         'returns DOS version * 100 (3.30 = 330)ππ  Regs.AX = &H3000                  'DOS get DOS version serviceπ  CALL Interrupt(DOS, Regs, Regs)π 'CALL Interrupt(DOS, Regs)         'use this with P.D.Q.ππ  'combine the major version in AL and the minor in AHπ  DOSVersion% = (Regs.AX AND 255) * 100 + (Regs.AX \ 256)ππEND FUNCTIONππSUB DrawBox (ULRow, ULCol, LRRow, LRCol, Style) STATICπ π  Length = LRCol - ULCol + 1            'calculate this just onceπ π  IF Style = 1 THENπ    LineType = 196π    VertBar$ = "│"π  ELSEπ    LineType = 205π    VertBar$ = "║"π  END IFππ  FOR X = ULRow TO LRRow                'first draw the wallsπ    LOCATE X, ULColπ    Temp = 32π    IF X = ULRow OR X = LRRow THEN Temp = LineTypeπ    PRINT VertBar$; STRING$(Length - 2, Temp); VertBar$;π  NEXTππ  IF Style = 1 THEN                     'then draw the cornersπ    LOCATE ULRow, ULCol: PRINT "┌";π    LOCATE ULRow, LRCol: PRINT "┐";π    LOCATE LRRow, ULCol: PRINT "└";π    LOCATE LRRow, LRCol: PRINT "┘";π  ELSEπ    LOCATE ULRow, ULCol: PRINT "╔";π    LOCATE ULRow, LRCol: PRINT "╗";π    LOCATE LRRow, ULCol: PRINT "╚";π    LOCATE LRRow, LRCol: PRINT "╝";π  END IFππEND SUBππSUB DrawScreen STATICππ  SHARED MainFG, MainBG, Bar$π π  '---- Draw the title screen and surrounding boxes.π  'π  COLOR MainFG, MainBG: CLS : LOCATE , , 0π  CALL DrawBox(One, One, 24, 80, 2)π  LOCATE 2, 24: PRINT "PC Magazine's PC-SETUP Version 1.00"π  LOCATE 3, 1: PRINT Bar$π π  CALL DrawBox(3, 27, 24, 43, One)π  LOCATE 3, 27:  PRINT "╤═══════════════╤";π  LOCATE 24, 27: PRINT "╧═══════════════╧";π π  LOCATE 4, 3: PRINT "Destination Directories";π  LOCATE , 31: PRINT "ZIP Files";π  LOCATE , 58: PRINT "Comments"ππ  LOCATE 25, 2π  PRINT "Up/Down/Space: Select files    Tab: Edit destination    F2: Begin    Esc: Quit";π πEND SUBππSUB EarlyEnd STATICππ  IF Prompt%(One) THENπ    COLOR 7, 0π    CLSπ    LOCATE 24, , 1π    ENDπ  END IFπ  LOCATE , , 0ππEND SUBππSUB Editor (Text$, Row, LeftCol, Length, KeyCode) STATICππ  SHARED HiFG, HiBG, NormFG, NormBG, MonoMon, CsrSizeππ  '----- Work with a temporary copy.π  Edit$ = SPACE$(Length)π  LSET Edit$ = Text$ππ  '----- See where to begin editing and print the string.π  TxtPos = 1π  LOCATE Row, LeftCol, 1, CsrSize - 1, CsrSizeπ  COLOR HiFG, HiBGπ  PRINT Edit$;ππ  '----- This is the main loop for handling key presses.π  DOπ     LOCATE , LeftCol + TxtPos - 1, 1ππ     DOπ       Ky$ = UCASE$(INKEY$)π     LOOP UNTIL LEN(Ky$)        'wait for a keypressππ     IF LEN(Ky$) = 1 THEN       'create a key codeπ       KeyCode = ASC(Ky$)       'regular character keyπ     ELSE                       'extended keyπ       KeyCode = -ASC(RIGHT$(Ky$, 1))π     END IFππ     '----- Branch according to the key pressed.π     SELECT CASE KeyCodeππ       '----- Backspace: decrement the pointer and theπ       '      cursor, and ignore if in the first column.π       CASE 8π         TxtPos = TxtPos - 1π         IF TxtPos < 1 THEN TxtPos = 1π         LOCATE , LeftCol + TxtPos - 1, 0π         IF TxtPos > 0 THENπ           IF InsStatus THENπ             MID$(Edit$, TxtPos) = MID$(Edit$, TxtPos + 1) + " "π           ELSEπ             MID$(Edit$, TxtPos) = " "π           END IFπ           PRINT MID$(Edit$, TxtPos);π         END IFππ       '----- Enter or Escape: this block is optional inπ       '      case you want to handle these separately.π       CASE 13, 27π         EXIT DO                'exit the subprogramππ       '----- Letter keys: turn off the cursor to hideπ       '      the printing, handle Insert mode as needed.π       CASE 32 TO 254π         LOCATE , , 0π         IF InsStatus THEN      'expand the stringπ           MID$(Edit$, TxtPos) = Ky$ + MID$(Edit$, TxtPos)π           PRINT MID$(Edit$, TxtPos);π         ELSE                   'else insert characterπ           MID$(Edit$, TxtPos) = Ky$π           PRINT Ky$;π         END IFπ         TxtPos = TxtPos + 1    'update position counterπ         IF TxtPos > Length THEN TxtPos = Lengthππ       '----- Left arrow: decrement the position counter.π       CASE -75π         TxtPos = TxtPos - 1π         IF TxtPos < 1 THEN TxtPos = 1ππ       '----- Right arrow: increment position counter.π       CASE -77π         TxtPos = TxtPos + 1π         IF TxtPos > Length THEN TxtPos = Lengthππ       '----- Home: jump to the first character position.π       CASE -71π         TxtPos = 1ππ       '----- End: search for the last non-blank, andπ       '      make that the current editing position.π       CASE -79π         FOR N = Length TO 1 STEP -1π           IF MID$(Edit$, N, 1) <> " " THEN EXIT FORπ         NEXTπ         TxtPos = N + 1π         IF TxtPos > Length THEN TxtPos = Lengthππ       '----- Insert key: toggle the Insert state andπ       '      adjust the cursor size.π       CASE -82π         InsStatus = NOT InsStatusπ         IF InsStatus THENπ           LOCATE , , , CsrSize \ 2, CsrSizeπ         ELSEπ           LOCATE , , , CsrSize - 1, CsrSizeπ         END IFππ       '----- Delete: delete the current character andπ       '      reprint what remains in the string.π       CASE -83π         MID$(Edit$, TxtPos) = MID$(Edit$, TxtPos + 1) + " "π         LOCATE , , 0π         PRINT MID$(Edit$, TxtPos);ππ       '---- All other keys: exit the subprogramπ       CASE ELSEπ         EXIT DOπ     END SELECTππ  '----- Loop until the cursor moves out of the field.π  LOOPππ  LSET Edit$ = LTRIM$(Edit$)    'trim and reprint the text in the normalπ  LOCATE , 2                    ' color before returningπ  COLOR NormFG, NormBGπ  PRINT Edit$ππ  Text$ = RTRIM$(Edit$)         'now trim what's on the right tooπ πEND SUBππSUB ErrorEnd (Message$) STATICππ  COLOR 7, 0π  CLSπ  LOCATE 13, 34 - LEN(Message$) \ 2, 1π  PRINT "Error: "; Message$; ", ending."π  ENDππEND SUBππFUNCTION Execute% (Program$, Parameter$) STATICπ π  '---- Prepare the program name and parameter strings for processing.  DOSπ  '     requires that the parameter string hold the length of the parameterπ  '     text, followed by the parameter text, and then followed by a CHR$(13)π  '     Enter byte.  The parameter block holds two CHR$(0) bytes followed byπ  '     the address and segment of the parameter string.π  'π  DIM Block AS STRING * 14         'this is the DOS parameter blockπ  DIM Parm AS STRING * 50          'and this is the actual parameter textπ π  ZBuffer$ = Program$ + Zero$      'make an ASCIIZ string for DOSπ π  LSET Parm$ = CHR$(LEN(Parameter$)) + Parameter$ + CHR$(13)π  LSET Block$ = Zero$ + Zero$ + MKI$(VARPTR(Parm$)) + MKI$(VARSEG(Parm$))ππ  Dummy& = SETMEM(-500000)         'free up memory for PKUNZIP to runππ  Regs.AX = &H4B00                 'DOS load/execute functionπ  Regs.DX = VARPTR(ZBuffer$)       'offset of program name into DXπ  Regs.ES = VARSEG(Block$)         'segment of parameter block into ESπ  Regs.BX = VARPTR(Block$)         'offset of parameter block into BXπ  Regs.DS = -1                     'set DS to BASIC's segmentπ  CALL InterruptX(DOS, Regs, Regs) 'execute it as subordinate processπ 'CALL InterruptX(DOS, Regs)       'use this with P.D.Q.ππ  IF Regs.Flags AND 1 THEN         'DOS had an error trying to run PKUNZIPπ    Execute% = -Regs.AX            'set function value to exit codeπ    EXIT FUNCTIONπ  END IFππ  Regs.AX = &H4D00                 'retrieve subordinate process codeπ  CALL Interrupt(DOS, Regs, Regs)π 'CALL Interrupt(DOS, Regs)        'use this with P.D.Q.π  Execute% = Regs.AX               'set function value to exit codeππ  Dummy& = SETMEM(500000)          'reclaim the memory reliquished earilerππEND FUNCTIONππFUNCTION ExeName$ STATICππ  'Returns the name of the currently running program; requires DOS 3.0 +ππ  '---- DOS Interrupt &H21 service &H62 returns the PSP segment in BXπ  Regs.AX = &H6200π  CALL Interrupt(DOS, Regs, Regs)π 'CALL Interrupt(DOS, Regs)             'use this with P.D.Q.ππ  '---- The environment segment is at address &H2C/&H2D in PSP segmentπ  DEF SEG = Regs.BXπ  DEF SEG = PEEK(&H2C) + PEEK(&H2D) * 256ππ  '---- Search the environment segment for two zero bytes in a row.  A countπ  '     word (which we skip over) follows that, and the program name followsπ  '     the count word.π  Byte = 0π  DOπ    IF PEEK(Byte) = 0 THEN              'this is zeroπ      IF PEEK(Byte + 1) = 0 THEN        'this is tooπ        Byte = Byte + 2                 'so skip bothπ        EXIT DO                         'all doneπ      END IFπ    END IF                              'else,π    Byte = Byte + 1                     'keep lookingπ  LOOPππ  IF PEEK(Byte) = 1 THEN                'if this count byte = 1π    Byte = Byte + 2                     'the name followsπ    DO WHILE PEEK(Byte)                 'up to another zeroπ      Tmp$ = Tmp$ + CHR$(PEEK(Byte))    'this is a different Tmp$ on purposeπ      Byte = Byte + 1π    LOOPπ    ExeName$ = Tmp$                     'assign the function outputπ  END IFππEND FUNCTIONππFUNCTION FileCount% (FileSpec$, DirFlag)π π  Regs.DX = VARPTR(DTA)                 'set new DTA addressπ  Regs.AX = &H1A00                      'specify service 1Ahπ  CALL Interrupt(DOS, Regs, Regs)       'DOS set DTA serviceπ 'CALL Interrupt(DOS, Regs)             'use this with P.D.Q.ππ  Temp = 0                              'clear the counterπ  ZBuffer$ = FileSpec$ + Zero$          'make an ASCIIZ stringππ  Regs.DX = VARPTR(ZBuffer$)            'the file spec addressπ  Regs.CX = 39                          'file attribute = all filesπ  IF DirFlag THEN Regs.CX = 39 OR 16    'include directories tooπ  Regs.AX = &H4E00                      'find first matching name serviceππ  DOπ    CALL Interrupt(DOS, Regs, Regs)     'see if there's a matchπ   'CALL Interrupt(DOS, Regs)           'use this with P.D.Q.π    IF Regs.Flags AND 1 THEN EXIT DO    'no more filesππ    IF DirFlag THEN                     'do we want directories?π      IF ASC(DTA.Attribute) AND 16 THEN 'yes, but is this a directory?π        IF ASC(DTA.FileName) <> 46 THEN 'filter "." and ".." (46 = period)π          Temp = Temp + 1               'we got another directory nameπ        END IFπ      END IFπ    ELSEπ      Temp = Temp + 1                   'we got another file nameπ    END IFπ     π    Regs.AX = &H4F00                    'find next name serviceπ  LOOPππ  FileCount% = Temp                     'assign the function outputπ πEND FUNCTIONππFUNCTION GetComment$ (Zip$) STATIC      'read comment from file named in Zip$ππ  ZipID$ = "PK" + CHR$(5) + CHR$(6)     'this identifies a file as a ZIP fileπ π  OPEN RTRIM$(Zip$) FOR BINARY AS #1    'open the .ZIP fileπ  FileSize& = LOF(1)                    'get and save its lengthπ  BufferSize = 3072                     'the default header sizeπ  IF BufferSize > FileSize& THEN BufferSize = FileSize&π  Temp$ = SPACE$(BufferSize)            'make buffer to receive ZIP headerππ  GET #1, FileSize& - BufferSize + 1, Temp$π  CLOSEππ  Temp = 0                              'find the last occurrence of PK IDπ  DOπ     HeaderOffset = Temp                'remember where this one isπ     Temp = INSTR(Temp + 1, Temp$, ZipID$)      'find the next oneπ  LOOP WHILE Temp                               'until no moreππ  IF HeaderOffset THEN                  'if there's a comment, extract itπ    CommentLen = CVI(MID$(Temp$, HeaderOffset + 20, 2))π    GetComment$ = MID$(Temp$, HeaderOffset + 22, CommentLen)π  END IFππ  Temp$ = ""                            'free up the memoryππEND FUNCTIONππFUNCTION GetDir$ STATICπ π  Regs.AX = &H4700                      'DOS get directory serviceπ  Regs.DX = 0                           'the drive goes in DL, 0 = defaultπ  Regs.SI = VARPTR(ZBuffer$)            'show DOS where ZBuffer$ isπ  CALL Interrupt(DOS, Regs, Regs)       'call DOSπ 'CALL Interrupt(DOS, Regs)             'use this with P.D.Q.π π  IF Regs.Flags AND 1 THEN              'must be an invalid driveπ    GetDir$ = ""π  ELSEπ    Temp = INSTR(ZBuffer$, Zero$)       'find the zero byte, and return onlyπ    GetDir$ = "\" + LEFT$(ZBuffer$, Temp - 1) ' what precedes itπ  END IFππEND FUNCTIONππFUNCTION GetDrive% STATICπ π  Regs.AX = &H1900                      'DOS Get Current Drive serviceπ  CALL Interrupt(DOS, Regs, Regs)       'call DOSπ 'CALL Interrupt(DOS, Regs)             'use this with P.D.Q.π  GetDrive% = (Regs.AX AND 255) + 65    'drive returned in AL as 0=A, 1=B...ππEND FUNCTIONππFUNCTION IntVal% (Work$) STATICππ 'IntVal is an integer-only VAL substitute that reduces .EXE size up to 10Kππ  Length = LEN(RTRIM$(Work$))π  Value = 0ππ  FOR X = Length TO 1 STEP -1π    Temp = MidChar%(Work$, X)π    IF Temp > 47 AND Temp < 58 THENπ      IF X = Length THENπ        Value = Temp - 48π      ELSEπ        Value = Value + (Temp - 48) * 10π      END IFπ    END IFπ  NEXTπ π  IntVal% = ValueππEND FUNCTIONππFUNCTION MakeDir% (DirName$) STATICππ  ZBuffer$ = DirName$ + Zero$           'make an ASCIIZ stringπ  Regs.AX = &H3900                      'DOS create directory serviceπ  Regs.DX = VARPTR(ZBuffer$)            'show DOS where ZBuffer$ isπ  CALL Interrupt(DOS, Regs, Regs)       'call DOSπ 'CALL Interrupt(DOS, Regs)             'use this with P.D.Q.ππ  IF Regs.Flags AND 1 THEN              'must be an invalid drive or bad nameπ    MakeDir% = -1                       'return -1 as an errorπ  END IFππEND FUNCTIONππFUNCTION MidChar% (Work$, Position)ππ  IF Position <= LEN(Work$) THENπ    MidChar% = ASC(MID$(Work$, Position, 1))π  ELSEπ    MidChar% = -1π  END IFππEND FUNCTIONππSUB MidCharS (Work$, Position, NewChar) STATICππ  MID$(Work$, Position, 1) = CHR$(NewChar)ππEND SUBππFUNCTION Prompt% (Which) STATICππ  SHARED HiFG, HiBG, MonoMon, CsrSize, DestPath$ππ  DEF SEG = &HB800                      'assume a color displayπ  IF MonoMon THEN DEF SEG = &HB000      'nope, use the mono video segmentππ  REDIM SaveScrn(10 TO 13, 14 TO 66)    'this saves the underlying screenπ  FOR Row = 10 TO 13                    'Here, Row and Col are zero-basedπ    FOR Col = 14 TO 66π      Temp = Row * 160 + Col * 2        'calculate the address just onceπ      SaveScrn(Row, Col) = PEEK(Temp) + 256 * PEEK(Temp + 1)π    NEXTπ  NEXTππ  COLOR HiFG, HiBGπ  CALL DrawBox(11, 15, 14, 67, One)     'draw the surrounding boxπ  IF Which THEN                         'we were called from EarlyEndπ    LOCATE 12, 31                       'show this directory nameπ    PRINT "Are you sure you want";      'print the prompt messageπ    LOCATE 13, 29, 1, CsrSize - 1, CsrSizeπ    PRINT "to quit installing? (Y/N) ";π  ELSE                                  'prompt if okay to overwrite filesπ    LOCATE 12, 17                       'show this directory nameπ    PRINT "Installing to "; DestPath$   'print the prompt messageπ    LOCATE 13, 17, 1, CsrSize - 1, CsrSizeπ    PRINT "Prompt before overwriting existing files? (Y/N) ";π  END IFπ  DO                                    'wait for Yes or No (only)π    Temp$ = UCASE$(INKEY$)π  LOOP UNTIL INSTR(" YN", Temp$) > 1π  Prompt% = 0                           'assume the answer is Noπ  IF Temp$ = "Y" THEN Prompt% = -1      'they answered Yesππ  FOR Row = 10 TO 13                    'now restore the screenπ    FOR Col = 14 TO 66                  'as aboveπ      Temp = Row * 160 + Col * 2π      POKE Temp, SaveScrn(Row, Col) AND 255π      POKE Temp + 1, SaveScrn(Row, Col) \ 256π    NEXTπ  NEXTππ  ERASE SaveScrnπ  LOCATE 2                              'put cursor at the top of the screenππEND FUNCTIONππSUB ReadNames (Spec$, Array$()) STATIC  'reads file names into an arrayππ  ZBuffer$ = Spec$ + Zero$              'make an ASCIIZ string of the specπ  CurFile = 0                           'zero out the file counterππ  Regs.DX = VARPTR(ZBuffer$)            'the file spec addressπ  Regs.CX = 39                          'file attribute = all filesπ  Regs.AX = &H4E00                      'find first matching name serviceππ  DOπ    CALL Interrupt(DOS, Regs, Regs)     'see if there's a matchπ   'CALL Interrupt(DOS, Regs)           'use this with P.D.Q.π    IF Regs.Flags AND 1 THEN EXIT DO    'no more filesππ    CurFile = CurFile + 1               'we found another file nameπ    Array$(CurFile) = SPACE$(12)        'create the string to hold itπ    Temp$ = DTA.FileName                'assign the nameπ    Temp = INSTR(Temp$, Zero$)          'find the terminating zero byteπ    LSET Array$(CurFile) = LEFT$(Temp$, Temp - 1) 'keep only what precedes itππ    Regs.AX = &H4F00                    'find the next nameπ  LOOPππEND SUBππSUB SelectFiles (FileNames$(), Choice, ExitCode) STATICππ  SHARED NumFiles, NormFG, NormBG, HiFG, HiBG, MainFG, MainBGππ  IF ExitCode = -60 THEN EXIT SUB       'we got here via F2 pressed in Editorππ  COLOR MainFG, MainBG                  'first display all of the choicesπ  LOCATE 25, 2                          'and update the status lineπ  PRINT "Up/Down/Space: Select files    Tab: Edit destination    F2: Begin    Esc: Quit";ππ  COLOR NormFG, NormBGπ  FOR Temp = 1 TO NumFilesπ    LOCATE 4 + Temp, 28, 0              'and turn off the cursorπ    PRINT FileNames$(Temp);π  NEXTππ  IF Choice = 0 THEN Choice = 1         'start at element 1 if first timeπ  IF Choice > UBOUND(FileNames$) THEN Choice = 1 'or if past the endππ  DOπ    LOCATE 4 + Choice, 28               'redraw current choice highlightedπ    COLOR HiFG, HiBGπ    PRINT FileNames$(Choice);π    DOπ      KeyHit$ = INKEY$                  'see what they want to doπ    LOOP UNTIL LEN(KeyHit$)             'wait for a keypressπ   π    IF LEN(KeyHit$) = 1 THEN            'set ExitCode based on the type ofπ      ExitCode = ASC(KeyHit$)            'key (extended or not) they pressedπ    ELSEπ      ExitCode = -ASC(MID$(KeyHit$, 2))π    END IFπ   π    IF ExitCode = 32 THEN               'spacebarπ      IF MidChar%(FileNames$(Choice), 2) = 251 THEN 'if it's now checkedπ        Temp = 32                       'remove the check markπ      ELSEπ        Temp = 251                       'else add a check markπ      END IFπ      CALL MidCharS(FileNames$(Choice), 2, Temp)π      ExitCode = -80                    'select the next file automaticallyπ    END IFππ    SELECT CASE ExitCodeπ      CASE -80                          'Down Arrowπ        GOSUB Deselectπ        Choice = Choice + 1π        IF Choice > NumFiles THEN Choice = 1π      CASE -79                          'End keyπ        GOSUB Deselectπ        Choice = NumFilesπ      CASE -72                          'Up Arrowπ        GOSUB Deselectπ        Choice = Choice - 1π        IF Choice = 0 THEN Choice = NumFilesπ      CASE -71                          'Homeπ        GOSUB Deselectπ        Choice = 1π      CASE -60                          'F2π        EXIT SUBπ      CASE 27                           'Escapeπ        EXIT SUBπ      CASE 9                            'Tabπ        LOCATE Choice + 4, 33π        GOSUB Deselectπ        EXIT SUBπ      CASE ELSE                         'this is needed for QB 4.0 onlyπ    END SELECTπ  LOOPππDeselect:                               're-paint the current choice, so itπ  LOCATE Choice + 4, 28                 '  won't appear activeπ  COLOR NormFG, NormBGπ  PRINT FileNames$(Choice);π  RETURNππEND SUBππSUB SetDrive (Drive$) STATICπ   π  Regs.AX = &HE00                       'DOS Set Drive service in AHπ  Regs.DX = ASC(UCASE$(Drive$)) - 65    'DL = 0 for A:, 1 for B:, and so onππ  CALL Interrupt(DOS, Regs, Regs)       'see if there's a matchπ 'CALL Interrupt(DOS, Regs)             'use this with P.D.Q.ππEND SUBππFUNCTION SourceDir$ STATICππ  Temp$ = ExeName$                  'get the directory we're running fromππ  FOR X = LEN(Temp$) TO 1 STEP -1   'isolate the drive letter and pathπ    Temp = MidChar%(Temp$, X)       '  (strip off the name PC-SETUP.EXE)π    IF Temp = 58 OR Temp = 92 THEN  'look for a colon or a backslashπ      SourceDir$ = LEFT$(Temp$, X)  'by searching for ":" or "\" this willπ      EXIT FOR                      ' work even if the program is renamedπ    END IFπ  NEXTππEND FUNCTIONππSUB StuffBuf (Cmd$) STATICπ       π  '----- Set the segment for poking, define the buffer head and tail, andπ  '      then poke each character into the keyboard buffer.π π  Temp = LEN(Cmd$)ππ  DEF SEG = 0π  POKE &H41A, &H1Eπ  POKE &H41C, &H1E + Temp * 2π   π  FOR X = 1 TO Tempπ    POKE &H41C + X * 2, ASC(MID$(Cmd$, X))π  NEXTππEND SUBππThe ABC Programmer             ADVANCED QWK READER            Try SIMPLE QWK READER          04-15-96 (01:10)       QB, QBasic, PDS        494  15280    QWKREAD.BAS '=====================[ More Complex QWK Reader ]=======================π'π' This QWK Reader let's you read the MESSAGES.DAT file contained in allπ' .QWK Packets.  Also allows for easy dumping QWK --> ASCII TXT Format.π'π' Original PASCAL code by Swag Support Team (Gayle Davis)π' Converted and optimized to BASIC by William Yu (04-15-96)π'π' Advanced features for this QWK Reader include:π'   * Option of extracting single messagesπ'   * Full message scrollπ'   * Ability to choose which message to readπ'π' Basic colors (B&W) for monochrome support.π' Careful, comment out the PCOPY routine and uncomment the BSAVE/BLOADπ' routine in SUB MessageList if you do have a monochrome adapter.π'π' I've tried to implement as many features without adding too muchπ' extraneous code.π' This program leaves much to be desired, here are some suggestions:π'π'    - Unpack .QWK on the flyπ'    - Option of sending the message to printerπ'    - Option of changing the saved message file nameπ'    - Search optionπ'    - Use screen scroll routineπ'----------------------------------------------------------------------ππ'$DYNAMICπDEFINT A-ZπDECLARE SUB DumpHeader (QWK AS ANY)πDECLARE SUB ReadMessage (HDR AS ANY, RelNum&, Chunks)πDECLARE SUB ReadMsg (NumChunks)πDECLARE SUB ReadWriteHdr (QWK AS ANY)πDECLARE SUB DrawBox (X%, Y%, XX%, YY%, C%, BC%, Solid%, CharSet%)πDECLARE SUB MessageList (Messages&(), Max%, QWK AS ANY)πDECLARE SUB DisplayMessage (Messages&(), FPNum, QWK AS ANY, Max)ππCONST Height = 25                     ' 25/43/50πCONST False = 0                       ' False = 0πCONST True = NOT False                ' True = -1πCONST DumpQWKtoFile = False           ' Dump messages to file?π                                      ' True = Dump to fileπ                                      ' False = View from screenπCONST DumpQWKFileName$ = "DUMP.MSG"   ' Dump messages to this file nameπCONST QWKPacket$ = "MESSAGES.DAT"     ' MESSAGES.DAT or *.SWGπ                                      ' Specify the path if requiredπTYPE MSGDatHdr                        ' MESSAGES.DAT File Structureπ    Status   AS STRING * 1            '  128 bytes altogetherπ    MSGNum   AS STRING * 7π    Date     AS STRING * 8π    Time     AS STRING * 5π    UpTO     AS STRING * 25π    UpFROM   AS STRING * 25π    Subject  AS STRING * 25π    PassWord AS STRING * 12           ' Never/rarely usedπ    ReferNum AS STRING * 8π    NumChunk AS STRING * 6π    Alive    AS STRING * 1π    LeastSig AS STRING * 1            ' Conference #π    MostSig  AS STRING * 1            ' Used for conf. # greater than 255π    Reserved AS STRING * 3πEND TYPEππDIM QWK AS MSGDatHdrπDIM Messages&(10000)ππWIDTH 80, HeightπCLSππ  OPEN QWKPacket$ FOR BINARY AS #1π  IF DumpQWKtoFile THEN OPEN DumpQWKFileName$ FOR OUTPUT AS #2π  Count& = 129  ' Skip Copyright informationπ  Num = 0π  WHILE Count& < LOF(1)π        Num = Num + 1π        ReadMessage QWK, Count&, Chunksπ        A$ = INKEY$                          ' ESC Key quits/abortsπ        IF DumpQWKtoFile THENπ          LOCATE 1, 1π          PRINT USING "Complete: ###.#%"; (Count& + (128 * Chunks)) / LOF(1) * 100π          PRINT #2,π        ELSEπ          Messages&(Num) = Count&            ' Count number of messagesπ          LOCATE 1, 1: PRINT "Reading:"; Numπ          PRINT USING "Complete: ###.#%"; (Count& + (128 * Chunks)) / LOF(1) * 100π        END IFπ        IF A$ = CHR$(27) THEN CLOSE : END    ' ESC quits Viewing or Dumpingπ        Count& = Count& + (128 * Chunks)π  WENDπ  CLSπ  IF NOT DumpQWKtoFile THEN MessageList Messages&(), Num, QWKπ  CLOSEπ  ENDππREM $STATICπSUB DisplayMessage (Messages&(), FPNum, QWK AS MSGDatHdr, Max)ππBakFPNum = FPNum        ' So we don't get confused when we jump Next/PrevππBeginHere:π π  DIM Buff AS STRING * 128  ' Read in 128 byte blocksπ  DIM SetString AS STRING * 80π  DIM Text$(500)            ' Too lazy to implement file pointers :>π                            ' Messages usually don't exceed 500 lines anywaysπ  COLOR 7, 0: CLSπ  LOCATE Height, 1: COLOR 0, 7: PRINT "  Up/Down/PgUp/PgDn/Home/End       E[";π  COLOR 15: PRINT "X"; : COLOR 0: PRINT "]tract   +/- [N]ext/[P]rev              ";π  COLOR 7, 0π  LOCATE 2, 1π    SEEK #1, Messages&(FPNum)π    ReadWriteHdr QWKπ    Chunks = VAL(QWK.NumChunk)π    PRINT "  Date: "; QWK.Date; " ("; QWK.Time; ")";π    PRINT , , "Number: "; QWK.MSGNumπ    PRINT "  From: "; QWK.UpFROM;π    PRINT , "Refer#: "; QWK.ReferNumπ    PRINT "    To: "; QWK.UpTO;π    PRINT , " Recvd: ";π    InCase$ = "-`^#"π    IF INSTR(QWK.Status, InCase$) THENπ      PRINT "YES"π    ELSEπ      PRINT "NO"π    END IFπ    PRINT "  Subj: "; QWK.Subject;π    Conference$ = LTRIM$(STR$(ASC(QWK.MostSig) * 256 + ASC(QWK.LeastSig)))π    PRINT , "  Conf: "; "("; Conference$; ")"π    LOCATE 2, 66: PRINT USING "#### of ####"; FPNum; Maxπ    DrawBox 1, 1, 80, 6, 7, 0, 0, 1π π  N = 1π  FOR J = 1 TO Chunks - 1π    GET #1, , Buffπ    X = 1π    FOR I = 1 TO 128π      IF MID$(Buff, I, 1) = CHR$(227) THENπ        N = N + 1π      ELSEπ        Text$(N) = Text$(N) + MID$(Buff, I, 1)π      END IFπ    NEXT Iπ  NEXT Jπ  MaxNum = Nπ  LOCATE 5, 66: PRINT "# Lines:"; MaxNumπ  LOCATE 7ππFOR I = 1 TO Height - 7π  A = INSTR(Text$(I), ">")                        ' Quoteπ  IF A < 6 AND A > 0 THEN COLOR 15 ELSE COLOR 7   ' Color BrightWhiteπ  SetString = Text$(I)π  PRINT SetString;π  IF I = MaxNum THEN EXIT FORπNEXT IπI = 1πCOLOR 0, 7: LOCATE Height, 67: PRINT I; "..."; I + Height - 7;ππ  DOπ    DOπ      A$ = INKEY$π    LOOP UNTIL A$ <> ""π    IF LEN(A$) = 2 THEN Char = -ASC(RIGHT$(A$, 1)) ELSE Char = ASC(A$)π    SELECT CASE Charπ      CASE 43, 78, 110                  ' +/N Goto Next Messageπ        FPNum = FPNum + 1π        IF FPNum > Max THEN FPNum = 1π        ERASE Text$π        GOTO BeginHereπ      CASE 45, 80, 112                  ' -/P Goto Previous Messageπ        FPNum = FPNum - 1π        IF FPNum = 0 THEN FPNum = Maxπ        ERASE Text$π        GOTO BeginHereπ      CASE 88, 120                      ' X - Extract Messageπ        FileName$ = LTRIM$(STR$(FPNum)) + ".MSG"π        OPEN FileName$ FOR OUTPUT AS #2π        DumpHeader QWKπ        FOR X = 1 TO MaxNumπ           PRINT #2, Text$(X)π        NEXT Xπ        CLOSE #2π        LOCATE 3, 63: COLOR 15, 0: PRINT "Saved as "; FileName$π      CASE -72                          ' Up arrow keyπ        IF I > 1 THENπ          I = I - 1π          GOSUB ShowMessageπ        END IFπ      CASE -73                          ' PageUpπ        I = I - Height + 7π        IF I < 1 THEN I = 1π        GOSUB ShowMessageπ      CASE -80                          ' Down arrow keyπ        IF I < MaxNum THENπ          I = I + 1π          GOSUB ShowMessageπ        END IFπ      CASE -81                          ' PageDownπ        I = I + Height - 7π        IF I > MaxNum - Height + 7 THEN I = MaxNum - Height + 7π        GOSUB ShowMessageπ      CASE -79                          ' Endπ        I = MaxNum - Height + 7π        GOSUB ShowMessageπ      CASE -71                          ' Homeπ        I = 1π        GOSUB ShowMessageπ      CASE 27                           ' Escape key pressedπ         GOTO BackToIndexπ    END SELECTπ  LOOPππShowMessage:π  IF MaxNum < Height - 7 THEN RETURNπ  LOCATE 7, 1π  FOR X = 1 TO Height - 7π    A = INSTR(Text$(I), ">")                            ' Quoteπ    IF A < 6 AND A > 0 THEN COLOR 15, 0 ELSE COLOR 7, 0 ' Color BrightWhiteπ    SetString = Text$(I)π    PRINT SetString;π    IF I >= MaxNum THEN EXIT FORπ    I = I + 1π  NEXT Xπ  I = I - Height + 7π  COLOR 0, 7: LOCATE Height, 67: PRINT I; "..."; I + Height - 7;πRETURNππBackToIndex:π  FPNum = BakFPNumππEND SUBππSUB DrawBox (X%, Y%, XX%, YY%, C%, BC%, Solid%, CharSet%)ππIF CharSet% = 1 THENπ  Char1$ = "┌"π  CharHoz$ = "─"π  Char2$ = "┐"π  CharVert$ = "│"π  Char3$ = "└"π  Char4$ = "┘"πEND IFππIF CharSet% = 2 THENπ  Char1$ = "╔"π  CharHoz$ = "═"π  Char2$ = "╗"π  CharVert$ = "║"π  Char3$ = "╚"π  Char4$ = "╝"πEND IFππCOLOR C%, BC%πA = (XX% - X%) - 1πLOCATE Y%, X%: PRINT Char1$; STRING$(A, CharHoz$); Char2$;πFOR I = Y% + 1 TO YY% - 1π  LOCATE I, X%: PRINT CharVert$;π  IF Solid% = 1 THEN PRINT SPACE$(A);π  LOCATE I, XX%: PRINT CharVert$;πNEXT IπLOCATE YY%, X%: PRINT Char3$; STRING$(A, CharHoz$); Char4$;ππEND SUBππSUB DumpHeader (QWK AS MSGDatHdr)π   π    PRINT #2, STRING$(79, "=")π    PRINT #2, "   Date: "; QWK.Date; " ("; QWK.Time; ")";π    PRINT #2, , , "Number: "; QWK.MSGNumπ    PRINT #2, "   From: "; QWK.UpFROM;π    PRINT #2, , "Refer#: "; QWK.ReferNumπ    PRINT #2, "     To: "; QWK.UpTO;π    PRINT #2, , " Recvd: ";π    InCase$ = "-`^#"π    IF INSTR(QWK.Status, InCase$) THENπ      PRINT #2, "YES"π    ELSEπ      PRINT #2, "NO"π    END IFπ    PRINT #2, "Subject: "; QWK.Subject;π    Conference$ = LTRIM$(STR$(ASC(QWK.MostSig) * 256 + ASC(QWK.LeastSig)))π    PRINT #2, , "  Conf: "; "("; Conference$; ")"π    PRINT #2, STRING$(79, "-")ππEND SUBππSUB MessageList (Messages&(), Max, QWK AS MSGDatHdr)ππ' Scrolling up/down pages can be optimized by using a Screen Scroll routineπ' requiring either a call to ABSOLUTE() Function for QBasic or interruptπ' routines via INTRPT.OBJ in QB.LIBπ' Recommended ABC Packet: INTERRPT.ABC, DOS.ABC, and TEXT.ABC, ASMCODE.ABCππ  DrawBox 1, 1, 80, 3, 7, 0, 0, 2π  DrawBox 1, Height - 1, 80, Height, 7, 0, 0, 1π π  LOCATE 2, 3: PRINT "Number  From               To                 Subject                   Conf"π  FOR I = 1 TO Height - 5π    IF I > Max THEN EXIT FORπ    SEEK #1, Messages&(I)π    ReadWriteHdr QWKπ    LOCATE I + 3, 3: PRINT USING "#####"; VAL(QWK.MSGNum);π    PRINT "   "; LEFT$(QWK.UpFROM, 19);π    PRINT LEFT$(QWK.UpTO, 19); QWK.Subject;π    Conference$ = LTRIM$(STR$(ASC(QWK.MostSig) * 256 + ASC(QWK.LeastSig)))π    PRINT " ("; Conference$; ")";π  NEXT Iππ  Index = 1π  Position = 4π  SEEK #1, Messages&(Index)π  ReadWriteHdr QWKπ  COLOR 0, 7π  LOCATE Position, 2: PRINT USING " #####"; VAL(QWK.MSGNum);π  PRINT "   "; LEFT$(QWK.UpFROM, 19);π  PRINT LEFT$(QWK.UpTO, 19); QWK.Subject;π  Conference$ = LTRIM$(STR$(ASC(QWK.MostSig) * 256 + ASC(QWK.LeastSig)))π  PRINT " ("; Conference$; ")";π π  DOπ    DOπ      A$ = INKEY$π    LOOP UNTIL A$ <> ""π    IF LEN(A$) = 2 THEN Char = -ASC(RIGHT$(A$, 1)) ELSE Char = ASC(A$)π    SELECT CASE Charπ      CASE 13                          ' ENTER Pressedπ        PCOPY 0, 1π        'DEF SEG = &HB000              ' Uncomment these linesπ        'BSAVE "LIST.TMP", 0, 4000     ' for monochrome supportπ        DisplayMessage Messages&(), Index, QWK, Maxπ        PCOPY 1, 0π        'BLOAD "LIST.TMP"π        'KILL "LIST.TMP"π      CASE -72                          ' Up arrow keyπ        IF Index > 1 THENπ          COLOR 7, 0: GOSUB SelectMsgNumπ          Index = Index - 1π          Position = Position - 1π          COLOR 0, 7: GOSUB SelectMsgNumπ        END IFπ      CASE -73                          ' PageUpπ       IF Max >= Height - 5 THENπ        IF Index <> 1 THENπ          Index = Index - Height + 5 - (Position - 4)π          IF Index <= 0 THEN Index = 1: Position = 4π          X = Positionπ          GOSUB PrevPageπ          Position = Xπ          Index = Index + (Position - 4)π          COLOR 0, 7: GOSUB SelectMsgNumπ        END IFπ       END IFπ      CASE -80                          ' Down arrow keyπ        IF Index <> Max THENπ          COLOR 7, 0: GOSUB SelectMsgNumπ          Index = Index + 1π          Position = Position + 1π          COLOR 0, 7: GOSUB SelectMsgNumπ        END IFπ      CASE -81                          ' PageDownπ       IF Max >= Height - 5 THENπ        IF Index + (2 * Height) - (Position - 4) - 6 >= Max THENπ          Index = Maxπ          Position = Height - 2π        ELSEπ          Index = Index + (2 * Height) - 11 - (Position - 4)π        END IFπ        X = Positionπ        GOSUB NextPageπ        Position = Xπ        IF Index <> Max THENπ          Index = Index - Height + 6 + (Position - 4)π        ELSEπ          Position = Height - 2π          Index = Maxπ        END IFπ        COLOR 0, 7: GOSUB SelectMsgNumπ       END IFπ      CASE -79                          ' Endπ       IF Max >= Height - 5 THENπ        Index = Max: Position = Height - 2π        GOSUB NextPageπ        GOSUB SelectMsgNumπ       END IFπ      CASE -71                          ' Homeπ       IF Max >= Height - 5 THENπ        Index = 1: Position = 4π        GOSUB PrevPageπ        GOSUB SelectMsgNumπ       END IFπ      CASE 27                           ' Escape key pressedπ        CLOSE : COLOR 7, 0: CLS : ENDπ    END SELECTπ  LOOPππSelectMsgNum:π  IF Position > Height - 2 THEN GOSUB NextPageπ  IF Position = 3 THEN GOSUB PrevPageπ  SEEK #1, Messages&(Index)π  ReadWriteHdr QWKπ  LOCATE Position, 2: PRINT USING " #####"; VAL(QWK.MSGNum);π  PRINT "   "; LEFT$(QWK.UpFROM, 19);π  PRINT LEFT$(QWK.UpTO, 19); QWK.Subject;π  Conference$ = LTRIM$(STR$(ASC(QWK.MostSig) * 256 + ASC(QWK.LeastSig)))π  PRINT " ("; Conference$; ")";πRETURNππNextPage:π  Index = Index - Height + 5π  FOR I = 1 TO Height - 5π    Index = Index + 1π    IF Index >= Max THEN EXIT FORπ    SEEK #1, Messages&(Index)π    ReadWriteHdr QWKπ    COLOR 7, 0π    LOCATE I + 3, 2: PRINT USING " #####"; VAL(QWK.MSGNum);π    PRINT "   "; LEFT$(QWK.UpFROM, 19);π    PRINT LEFT$(QWK.UpTO, 19); QWK.Subject;π    Conference$ = LTRIM$(STR$(ASC(QWK.MostSig) * 256 + ASC(QWK.LeastSig)))π    PRINT " ("; Conference$; ")"π  NEXT Iπ  Position = Height - 2π  COLOR 0, 7πRETURNππPrevPage:π  Index = Index - 1π  FOR I = 1 TO Height - 5π    Index = Index + 1π    IF Index >= Max THEN EXIT FORπ    SEEK #1, Messages&(Index)π    ReadWriteHdr QWKπ    COLOR 7, 0π    LOCATE I + 3, 2: PRINT USING " #####"; VAL(QWK.MSGNum);π    PRINT "   "; LEFT$(QWK.UpFROM, 19);π    PRINT LEFT$(QWK.UpTO, 19); QWK.Subject;π    Conference$ = LTRIM$(STR$(ASC(QWK.MostSig) * 256 + ASC(QWK.LeastSig)))π    PRINT " ("; Conference$; ")";π  NEXT Iπ  Index = Index - (Height - 6)π  Position = 4: COLOR 0, 7πRETURNππEND SUBππSUB ReadMessage (QWK AS MSGDatHdr, RelNum&, Chunks)π π  SEEK #1, RelNum&π  ReadWriteHdr QWKπ  Chunks = VAL(QWK.NumChunk)π  IF DumpQWKtoFile THEN ReadMsg ChunksππEND SUBππSUB ReadMsg (NumChunks)ππ  DIM Buff AS STRING * 128ππ  FOR J = 1 TO NumChunks - 1π    GET #1, , Buffπ    FOR I = 1 TO 128π      IF MID$(Buff, I, 1) = CHR$(227) THENπ        PRINT #2,π      ELSEπ        PRINT #2, MID$(Buff, I, 1);π      END IFπ    NEXT Iπ  NEXT JππEND SUBππSUB ReadWriteHdr (QWK AS MSGDatHdr)ππ    GET #1, , QWK.Statusπ    GET #1, , QWK.MSGNumπ    GET #1, , QWK.Dateπ    GET #1, , QWK.Timeπ    GET #1, , QWK.UpTOπ    GET #1, , QWK.UpFROMπ    GET #1, , QWK.Subjectπ    GET #1, , QWK.PassWordπ    GET #1, , QWK.ReferNumπ    GET #1, , QWK.NumChunkπ    GET #1, , QWK.Aliveπ    GET #1, , QWK.LeastSigπ    GET #1, , QWK.MostSigπ    GET #1, , QWK.Reservedππ  IF DumpQWKtoFile THENπ    DumpHeader QWKπ  END IFππEND SUBππAndrew Jones                   TYPING DRILL                   FidoNet QUIK_BAS Echo          04-14-96 (14:33)       QB, QBasic, PDS        64   1408     TYPING.BAS  'Typing drill.  Very elementary, not sure if the timing is absolutelyπ'correct.ππCLSπword = 1πPRINT "Typing drill...  Type one sentence as quickly as you can..."πPRINT "It can be as short as you want or as long, but keep a constant length."πPRINT "The best drill sentence would be: 'The quick brown fox jumped over the lazy dog'"πPRINT "because it uses all alphabet keys...  Long sentences are more stastically"πPRINT "accurate."πPRINT "Timing starts at the first key pressed!"πPRINTπDOπb$ = INKEY$πLOOP UNTIL b$ <> ""πPRINT b$;πTIMER ONπON TIMER(1) GOSUB timerrπDOπa$ = INKEY$πSELECT CASE a$πCASE CHR$(8)πcorr = corr + 1πSOUND 400, .2πSOUND 500, .2πSOUND 400, .2πb$ = MID$(b$, 1, LEN(b$) - 1)πIF LEN(b$) >= 1 THENπLOCATE CSRLIN, POS(0) - 1πPRINT " ";πLOCATE CSRLIN, POS(0) - 1πELSEπLOCATE CSRLIN, 1πPRINT " ";πLOCATE CSRLIN, 1πEND IFπCASE CHR$(32) TO CHR$(127)πSOUND 200, .2πb$ = b$ + a$πPRINT a$;πCASE ELSEπEND SELECTπLOOP UNTIL a$ = CHR$(13)πFOR t = 1 TO LEN(b$)πm$ = MID$(b$, t, 1)πIF m$ = " " THEN word = word + 1πNEXTπPRINTπPRINTπPRINT "Statistics:"πIF sec = 0 THENπPRINT "No time was passed, at least according to significant figures used!"πENDπEND IFπPRINT "Seconds typing: "; secπPRINT "Words Per Second: "; word / secπPRINT "Words Per Minute: "; (word / sec) * 60πPRINT "Corrections Made: "; corrπ πENDπ πtimerr:πsec = sec + 1πRETURNπMichael Parker                 COM SUPPORT                    comp.lang.basic.misc           03-03-96 (07:25)       QB, QBasic, PDS        110  3328     COMSUPP.BAS '>   Help on how to access COM's 1 through 4 or 8. Please help.ππ'Here's a _very_ nice routine to open com1-com4 (up to 115k baud, too).π'These routines were written by Michael Parker.  Hope they help.π'Originally posted by Jonathan Leger <[e-mail]>ππ'--- START HERE ---ππ' Quick Basic Routine OpenComπ' This routine will accept the entire OPEN command parametersπ' that is in QB 4.5 , the only exception is the baud rate andπ' COM port.  Baud rate is optional, if specified, this moduleπ' will set the specifed rate up to 115,200.  If the baud rateπ' is specifed at 0, the specifed port will be polled  for theπ' current baud rate and the baud rate will be set at the rateπ' that is present, if any.  NOTE:  the baud rate parameter onπ' the command line IS  NOT optional,  if you want this moduleπ' to set the baud rate,  put an extra comma  into the commandπ' line to replace the baud rate.  The COM Port will accept upπ' to COM 4 now.ππ' OPENCOM "COMX:{option list1 [baudrate,parity,databit]},{option list2}π' AS FileNum"π' examples:π' OPENCOM "COM1:38400 as 1"π' OPENCOM "COM4:,op500 as 1"π' OPENCOM "COM2:2400,n,8,1,op500 as 4"π' OPENCOM "COM3:,,, OP500 as 2"ππDECLARE SUB OPENCOM (InString$)πCALL OPENCOM(InString$)πENDππSUB OPENCOM (Sting$)πSting$ = LTRIM$(RTRIM$(Sting$))πPort$ = UCASE$(LEFT$(Sting$, 5))πSting$ = RIGHT$(Sting$, LEN(Sting$) - 5)πFOR x = 1 TO LEN(Sting$)π     H$ = MID$(Sting$, x, 1)π     IF UCASE$(H$) = "A" THENπ          H$ = H$ + MID$(Sting$, x + 1, 1)π          IF UCASE$(H$) = "AS" THENπ                FileNum = VAL(MID$(Sting$, x + 2, LEN(Sting$)))π                EXIT FORπ          END IFπ     END IFπ     InputString$ = InputString$ + H$πNEXT xπFOR x = 1 TO LEN(InputString$)π     IF MID$(InputString$, x, 1) <> "," THENπ          BaudRate$ = BaudRate$ + MID$(InputString$, x, 1)π     ELSEπ          InputString$ = MID$(InputString$, x + 1, LEN(InputString$))π          EXIT FORπ     END IFπNEXT xπIF LTRIM$(BaudRate$) = "" THENπ     BaudRate& = 0πEND IFπSELECT CASE Port$π     CASE "COM1:"π          BaseAddr% = &H3F8π          Port1$ = "COM1:"π     CASE "COM2:"π          BaseAddr% = &H2F8π          Port1$ = "COM2:"π     CASE "COM3:"π          BaseAddr% = &H2F8π          Port1$ = "COM1:"π     CASE "COM4:"π          BaseAddr% = &H3F8π          Port1$ = "COM2:"π     CASE ELSEπ          PRINT "Illegal COM Port"πEND SELECTππIF BaudRate$ = "" THENπ     OUT BaseAddr% + 3, INP(BaseAddr% + 3) OR &H80π     LSB% = INP(BaseAddr%)π     MSB% = INP(BaseAddr% + 1)π     OUT BaseAddr% + 3, INP(BaseAddr% + 3) AND &H7Fπ     Divisor& = MSB% * &H100 + LSB%π     IF Divisor& = 0 THENπ          BaudRate& = 0π     ELSEπ          BaudRate& = 115200 / Divisor&π     END IFπELSEπ     BaudRate& = VAL(BaudRate$)πEND IFπIF LEFT$(InputString$, 1) <> "," THENπ     InputString$ = "," + InputString$πEND IFπOPEN Port1$ + "300" + InputString$ FOR RANDOM AS FileNumπIF Port$ = "COM3:" THENπ     POKE &H400, &HE8πELSEIF Port$ = "COM4:" THENπ     POKE &H402, &HE8πEND IFπIF BaudRate& <> 0 THENπ     Divisors# = 115200 / BaudRate&πEND IFπLCR = BaseAddr% + 3πTemp = INP(LCR)πOUT LCR, Temp OR 128πOUT BaseAddr% + 1, INT(Divisors# / 256)πOUT BaseAddr%, Divisors#πOUT LCR, Temp AND 127ππEND SUBπDick Dennison                  DIAL A PHONE NUMBER            QB Tidbits                     10-19-91 (00:00)       QB, QBasic, PDS        192  5630     DIAL.BAS    ' DIAL    BAS : Dial a phone number on the screenπ' author .....: Dick Dennison [74270,3636] 1:272/34 914-374-3903 *hst 24 hrsπ' supports ...: COM1 - COM4π' syntax .....: DIAL portnum%π' includes ...: Noneπ' notes ......: Move the cursor with the arrow keys to the phone numberπ'             : Press the ']' key and move the right arrow key acrossπ'             : the number and press Enterπ'             : Uses Basic's OPEN COMx commandsπ' cost .......: Free = Credit where credit dueπ'             : Do not use as is for commercial use - may not be resoldπ'             : May not be rebundled without prior written consentπ' dated ......: 10/19/91π' credits ....: Thanks to Mike Welch for CLIPMSG, and Pete Petrakis for his        π'             : notes on Com Port swapping.ππDECLARE SUB Hangup (Port%)πDECLARE SUB Getnum (row%, Col%, markit%, Port%)πDECLARE SUB Setup (Port%)ππCOLOR 0, 7πLOCATE 25, 1πPRINT "     Move the cursor to the beginning of the phone number and press Space  ";πLOCATE 10, 1πIF VAL(COMMAND$) < 1 OR VAL(COMMAND$) > 4 THEN      'Get the portnum%π     PRINT "Port number must be on command line"π     ENDπELSE Port% = VAL(COMMAND$)πEND IFπ                   π                    'Setup some special key functionsπCR$ = CHR$(13)πNul$ = CHR$(0)πArrowLt$ = Nul$ + CHR$(75)πArrowRt$ = Nul$ + CHR$(77)πArrowUp$ = Nul$ + CHR$(72)πArrowDn$ = Nul$ + CHR$(80)πEndKey$ = Nul$ + CHR$(79)πEsc$ = CHR$(27)πHome$ = Nul$ + CHR$(71)πSpaceBar$ = CHR$(32)π                   'Save vectors at bios Addresses for Com1-Com2π  OldPort1H = PEEK(&H400)π  OldPort1L = PEEK(&H401)π  OldPort2H = PEEK(&H402)π  OldPort2L = PEEK(&H403)ππ'Move cursor aroundπ'==================================================================πDO                         'This section lets the user moveπ In$ = INKEY$             'move the cursor around on the screenπ SELECT CASE In$          'to the beginning of the phone numberπ  CASE CR$π    IF markit% THEN       'A CR signals the end of the highlightπ     row% = CSRLINπ     Col% = POS(0) - count%π     EXIT DOπ    END IFπ  CASE Esc$                'ENDπ    ENDπ  CASE Home$               'Goto the beginning of the lineπ     LOCATE , 1π  CASE EndKey$             'Goto the end of the lineπ     LOCATE , 80π  CASE ArrowUp$            'UpArrowπ     x% = CSRLINπ     IF x% > 1 THEN LOCATE x% - 1π  CASE ArrowDn$            'DownArrowπ     x% = CSRLINπ     IF x% < 25 THEN LOCATE x% + 1π  CASE ArrowLt$                                 'LeftArrowπ     IF POS(0) > 1 THEN LOCATE , POS(0) - 1π     IF markit% THEN count% = count% - 1       'If markit% then ' ' was pressedπ  CASE ArrowRt$                             'RightArrowπ     π     IF markit% THENπ          count% = count% + 1               'If markit% then ' ' was pressedπ          row% = CSRLIN: Col% = POS(0)π          a% = SCREEN(row%, Col%)π          PRINT CHR$(a%);π     ELSEπ          IF POS(0) < 80 THEN LOCATE , POS(0) + 1π     END IFπ  CASE SpaceBar$π     IF markit% THENπ          count% = count% + 1               'If markit% then ' ' was pressedπ          row% = CSRLIN: Col% = POS(0)π          a% = SCREEN(row%, Col%)π          PRINT CHR$(a%);π     ELSEπ          BEEPπ          markit% = -1                      'Flag set for marking numberπ     END IFπ END SELECTπ LOCATE , , 1                   'Keep cursor flashingπLOOPπ'======================================================================ππ         'Get the phone number off the screenπGetnum row%, Col%, count%, Port%ππ         'Restore old vectorsπCLOSE 1π  DEF SEG = 0π     POKE &H400, OldPort1Hπ     POKE &H401, OldPort1Lπ     POKE &H402, OldPort2Hπ     POKE &H403, OldPort2Lπ  DEF SEGπENDππSUB Getnum (row%, Col%, markit%, Port%)πIF row% < 1 THEN row% = 1: IF Col% < 1 THEN Col% = 1πLOCATE row%, Col%πFOR x% = 0 TO markit%           'Read the phone number off the screenπ     a% = SCREEN(row%, Col% + x%)π     Dialstr$ = Dialstr$ + CHR$(a%)πNEXT x%πLOCATE 23, 25πPRINT "Dialing : "; Dialstr$;πLOCATE 25, 1πPRINT "             Pickup handset and then press space or ESC phone rings      ";πCOLOR 7, 0ππSetup Port%πPRINT #1, "ATM1DT" + Dialstr$     'Dial the numbarππDOπ     b$ = INKEY$π     IF b$ = " " THENπ          Hangup Port%π          EXIT DOπ     END IFπ     IF b$ = CHR$(27) THENπ          Hangup Port%π          EXIT DOπ     END IFπLOOPππEND SUBππSUB Hangup (Port%)ππPRINT "...Disconnecting 1";πSELECT CASE Port%                'Drop DTRπ    CASE 1π        OUT &H3FC, (INP(&H3FC) AND 252)   'com1π    CASE 2π        OUT &H2FC, (INP(&H2FC) AND 252)   'com2π    CASE 3π        OUT &H3FC, (INP(&H3FC) AND 252)   'com3π    CASE 4π        OUT &H2FC, (INP(&H2FC) AND 252)   'com4πEND SELECTπ     PRINT "...2...";π     PRINT #1, "+++";   'Switch to modem command modeπ     SLEEP 1π     PRINT #1, "ATH"    'Send hangup commandπ     PRINT "...CLICK";ππEND SUBππSUB Setup (Port%)π'Sets up the comport by swapping the address fo com4 with com2 andπ'com3 with com1 if necessaryπDEF SEG = 0π POKE &H400, &HF8π POKE &H401, 3π POKE &H402, &HF8π POKE &H403, 2ππSELECT CASE Port%π     CASE 1π        Start$ = "COM1:2400,N,8,1,DS0"π     CASE 2π        Start$ = "COM2:2400,N,8,1,DS0"π     CASE 3π        POKE &H400, &HE8   'For com1 to com3π        POKE &H401, &H3π        Start$ = "COM1:2400,N,8,1,DS0"π     CASE 4π        POKE &H402, &HE8   'For com2 to com4π        POKE &H403, &H2π        Start$ = "COM2:2400,N,8,1,DS0"πEND SELECTπDEF SEGπππOPEN Start$ FOR RANDOM AS 1ππEND SUBππHardin Brothers                MOUSE DEMO                     [e-mail]           01-25-96 (00:00)       QB, QBasic, PDS        474  12984    MOUSDEMO.BAS'----------------------------------------------------------------------------π'    FileName:  MOUSEDEMO.BAS for QBasic 1.xπ'      Author:  Hardin Brothersπ' Publication:  _DOS World_ issue #25 January 1996 pp.51-57π' DW Internet:  [e-mail]π'      DW BBS:  603-924-3181 [8-N-1]π'  DW Address:  DOS World, 86 Elm St., Peterborough, NH 03458  USAπ'    Comments:  To find out what the mouse is doing, your program must "talk"π'            :  to the mouse driver. A mouse and driver must be installedπ'            :  for this program to work. Then your program must make requestsπ'            :  of the mouse driver by calling Interrupt 33 hexadecimal. (Anπ'            :  Interrupt is similar to a CALL or GOSUB in QBasic, but insteadπ'            :  of working within a program, it lets one program call another,π'            :  without worrying about where the second program is in memory.π'            :π' Essential Mouse Servicesπ' Procedure  :  Purposeπ'------------:---------------------------------------------------------------π'   MouseCall:  Calls mouse and passes it a command via CPU registers.π'            :π'    MouseInt:  Initializes mouse and reports number of buttons. Returns 0π'            :  if mouse driver unavailable or mouse not present.π'            :π'  MouseSetup:  Sets up mouse machine-language routine. You must call thisπ'            :  subprocedure before calling any other service!π' -----------:---------------------------------------------------------------π' Optional Mouse Services   π' Procedure  :  Purposeπ' -----------:---------------------------------------------------------------π'   MouseShow:  Displays mouse cursor.π'            :π'   MouseHide:  Hides mouse cursor. To avoid appearance of "ghost" cursors,π'            :  use this service before printing or updating screen.π'            :π' MouseGetPr_:  Gets information about last mouse click. Shows which buttonπ'essInfo     :  is down, number of clicks since last call, vertical andπ'            :  horizontal position of cursor at last mouse click.π'            :π' MouseGetRe_:  Gets information about last release of mouse buttons. Useπ'leaseInfo   :  MouseGetPressInfo and MouseGetReleaseInfo together to letπ'            :  user drag objects around screen.π'            :π' MouseGetSt_:  Gets information on current status of mouse.π'atus        :π' MouseReadC_:  Returns horizontal and vertical position of mouse cursor,π'ounters     :  relative to its location last time function called.π'            :π' MouseSetHo_:  Restricts mouse movement by setting minimum and maximumπ'rzRange     :  horizontal range of mouse cursor.π'            :π' MouseSetVe_:  Restricts mouse movement by setting minimum and maximumπ'rtRange     :  vertical range of mouse cursor.π'            :π'MouseSetPosn:  Sets mouse cursor to correspond to values of HPosn% and VPosn%π'            :π'            :π'----------------------------------------------------------------------------πDECLARE SUB Demo3 ()πDECLARE SUB Demo2 ()πDECLARE SUB Demo1 ()πDECLARE FUNCTION MouseInit% ()πDECLARE SUB MouseCall ()πDECLARE SUB MouseGetPressInfo (LBtn%, RBtn%, MBtn%, Count%, HPosn%, VPosn%)πDECLARE SUB MouseGetReleaseInfo (LBtn%, RBtn%, MBtn%, Count%, HPosn%, VPosn%)πDECLARE SUB MouseGetStatus (LBtn%, RBtn%, MBtn%, HPosn%, VPosn%)πDECLARE SUB MouseHide ()πDECLARE SUB MouseReadCounters (HCount%, VCount%)πDECLARE SUB MouseSetHorizRange (HMin%, HMax%)πDECLARE SUB MouseSetPosn (HPosn%, VPosn%)πDECLARE SUB MouseSetup ()πDECLARE SUB MouseSetVertRange (VMin%, VMax%)πDECLARE SUB MouseShow ()ππMouseInt:π' Machine language routine 40 bytes long:πDATA 55          : 'PUSH BPπDATA 89, E5      : 'MOV  BP, SPπDATA 56          : 'PUSH SIπDATA 8B, 76, 06  : 'MOV  SI,[BP+6]πDATA 8B, 04      : 'MOV  AX,[SI]πDATA 8B, 5C, 02  : 'MOV  BX,[SI+2]πDATA 8B, 4C, 04  : 'MOV  CX,[SI+4]πDATA 8B, 54, 06  : 'MOV  DX,[SI+6]πDATA 8E, 44, 08  : 'MOV  ES,[SI+8]πDATA CD, 33      : 'INT  33hπDATA 8C, 44, 08  : 'MOV  [SI+8],ESπDATA 89, 54, 06  : 'MOV  [SI+6],DXπDATA 89, 4C, 04  : 'MOV  [SI+4],CXπDATA 89, 5C, 02  : 'MOV  [SI+2],BXπDATA 89, 04      : 'MOV  [SI],AXπDATA 5E          : 'POP     SIπDATA 5D          : 'POP  BPπDATA CB          : 'RETFππTYPE MouseRegsπ  AX AS INTEGERπ  BX AS INTEGERπ  CX AS INTEGERπ  DX AS INTEGERπ  ES AS INTEGERπEND TYPEππDIM SHARED MReg AS MouseRegsπREDIM SHARED MouseRoutine%(0 TO 19)πDIM SHARED MouseReady%πMouseReady% = 0πMouseSetupπMouseReady% = MouseInitππDEFINT A-ZππCLSπTYPE TextMaskπ  Bg AS INTEGERπ  Fg AS INTEGERπ  Char AS INTEGERπ  Mask AS INTEGERπEND TYPEππIF MouseReady% THENπ  Demo1π  Demo2π  Demo3πELSEπ  CLSπ  PRINT "No Mouse available for demonstration"πEND IFπENDππSUB Demo1π'*π'* display the mouseπ'* and its current statusπ'*π  CLSπ  PRINT , , "Press Esc to end"π  PRINT "Mouse has"; MouseReady%; "buttons";π  MouseShowπ  DOπ    CALL MouseGetStatus(L%, R%, M%, Horiz%, Vert%)π    LOCATE 3, 1π    IF L% THEN PRINT "Left Dn";  ELSE PRINT "Left Up";π    IF MouseReady > 2 THENπ      IF M% THEN PRINT " -- Mid Dn";  ELSE PRINT " -- Mid Up";π    END IFπ    IF R% THEN PRINT " -- Right Dn";  ELSE PRINT " -- Right Up";π    LOCATE 4, 1π    PRINT USING "Mouse at column ### and row ###"; Horiz%; Vert%π    Esc$ = INKEY$π  LOOP UNTIL Esc$ = CHR$(27)π  MouseHideπEND SUBππSUB Demo2π  RANDOMIZE TIMERπ  MouseShowπ  DOπ    CLSπ    PRINT "Click left button for new window - right button to end. "π    Top = INT(RND * 15) + 2π    Vert = INT(RND * (22 - Top)) + 3π    Left = INT(RND * 60) + 1π    Horiz = INT(RND * (77 - Left)) + 3π    LOCATE Top, Leftπ    PRINT CHR$(201); STRING$(Horiz, 205); CHR$(187);π    FOR I = 1 TO Vertπ      LOCATE Top + I, Leftπ      PRINT CHR$(186); STRING$(Horiz, 32); CHR$(186);π    NEXT Iπ    LOCATE Top + Vert, Leftπ    PRINT CHR$(200); STRING$(Horiz, 205); CHR$(188);π    CALL MouseSetHorizRange(Left * 8, (Left + Horiz - 1) * 8)π    CALL MouseSetVertRange(Top * 8, (Top + Vert - 2) * 8)πDemo2LP:π  L = 0: R = 1: M = 0π  CALL MouseGetPressInfo(L, R, M, CNT, H, V)π  IF R THENπ    MouseHideπ    EXIT SUBπ  END IFπ  L = 1: R = 0: M = 0π  CALL MouseGetPressInfo(L, R, M, CNT, H, V)π  IF L = 0 THEN GOTO Demo2LPπ  DOπ    CALL MouseGetStatus(L, R, M, H, V)π  LOOP UNTIL (L OR R OR M) = 0πLOOPπEND SUBππSUB Demo3π  CLSπ  PRINT "Press Esc to end"π  PRINT "Use mouse and left button or arrow keys and Enter to select"π  DIM CH$(1 TO 4)π  FOR I = 1 TO 4π    CH$(I) = CHR$(64 + I)π    LOCATE 10 + I, 35π    PRINT "Select "; CH$(I);π  NEXT Iπ  COLOR 0, 7π  LOCATE 11, 35π  PRINT "Select "; CH$(1);π  OldSel = 1π  Hit = 0π  CALL MouseSetHorizRange(34 * 8, 34 * 8)π  CALL MouseSetVertRange(10 * 8, 13 * 8)π  CALL MouseSetPosn(34 * 8, 10 * 8)π  DOπ    CALL MouseGetStatus(L, R, M, H, V)π    Sel = V \ 8 - 9π    Hit = L OR R OR Mπ    K$ = INKEY$π    IF LEN(K$) THENπ      SELECT CASE K$π        CASE CHR$(27)             'Escπ          EXIT SUBπ        CASE CHR$(0) + CHR$(72)   'Up arrowπ          IF Sel > 1 THEN Sel = Sel - 1π        CASE CHR$(0) + CHR$(80)   'Dn arrowπ          IF Sel < 4 THEN Sel = Sel + 1π        CASE CHR$(13)π          Hit = -1π      END SELECTπ    END IFπ    IF Sel <> OldSel THENπ      COLOR 7, 0π      LOCATE 10 + OldSel, 35π      PRINT "Select "; CH$(OldSel);π      COLOR 0, 7π      LOCATE 10 + Sel, 35π      PRINT "Select "; CH$(Sel);π      OldSel = Selπ      IF Sel <> V \ 8 - 9 THENπ        CALL MouseSetPosn(34 * 8, (Sel + 9) * 8)π      END IFπ    END IFπ    IF Hit THENπ    COLOR 7, 0π    LOCATE 25, 1π    PRINT USING "Selected &"; CH$(Sel);π    Hit = 0π  END IFπLOOPπEND SUBππSUB MouseCallπ'*π'* Call mouse using current values in MReg registersπ'*π  DEF SEG = VARSEG(MouseRoutine%(0))π  Addr% = VARPTR(MouseRoutine%(0))π  CALL Absolute(MReg, Addr%)π  DEF SEGπEND SUBππSUB MouseGetPressInfo (LBtn%, RBtn%, MBtn%, Count%, HPosn%, VPosn%)π'*π'* Gets info about last mouse clickπ'* Set LBtn%, RBtn%, or MBtn% <> 0 for button to queryπ'* LBtn%, RBtn%, or MBtn% return 1 to show whichπ'* button is currently down or 0 to show which buttonπ'* is currently upπ'* Count% has count of clicks since last callπ'* HPosn% and VPosn% are horizontal and vertical positionπ'* of cursor at last clickπ'*π  IF MouseReady% THENπ    IF (LBtn% OR RBtn% OR MBtn%) <> 0 THENπ      MReg.AX = 5π      IF LBtn% THEN MReg.BX = 0π      IF RBtn% THEN MReg.BX = 1π      IF MBtn% THEN MReg.BX = 2π      MouseCallπ      LBtn% = MReg.AX AND 1π      RBtn% = (MReg.AX AND 2) \ 2π      MBtn% = (MReg.AX AND 4) \ 4π      Count% = MReg.BXπ      HPosn% = MReg.CXπ      VPosn% = MReg.DXπ    ELSEπ      CALL MouseGetStatus(LBtn%, RBtn%, MBtn%, HPosn%, VPosn%)π      Count% = 0π    END IFπ  ELSEπ    LBtn% = 0: RBtn% = 0: MBtn% = 0π    Count% = 0π    HPosn% = -1: VPosn% = -1π  END IFπEND SUBππSUB MouseGetReleaseInfo (LBtn%, RBtn%, MBtn%, Count%, HPosn%, VPosn%)π'*π'* Gets info about last mouse releaseπ'* Set LBtn%, RBtn%, or MBtn% <> 0 for button queryπ'* LBtn%, RBtn%, or MBtn% return 1 to show whichπ'* button is currently down or 0 to show whichπ'* button is currently upπ'* Count% has count of releases since last callπ'* HPosn% and VPosn% are horizontal and vertical positionπ'* of cursor at last releaseπ'*π  IF MouseReady% THENπ    IF (LBtn% OR RBtn% OR MBtn%) <> 0 THENπ      MReg.AX = 6π      IF LBtn% THEN MReg.BX = 0π      IF RBtn% THEN MReg.BX = 1π      IF MBtn% THEN MReg.BX = 2π      MouseCallπ      LBtn% = MReg.AX AND 1π      RBtn% = (MReg.AX AND 2) \ 2π      MBtn% = (MReg.AX AND 4) \ 4π      Count% = MReg.BXπ      HPosn% = MReg.CXπ      VPosn% = MReg.DXπ    ELSEπ      CALL MouseGetStatus(LBtn%, RBtn%, MBtn%, HPosn%, VPosn%)π      Count% = 0π    END IFπ  ELSEπ    LBtn% = 0: RBtn% = 0: MBtn% = 0π    Count% = 0π    HPosn% = -1: VPosn% = -1π  END IFπEND SUBππSUB MouseGetStatus (LBtn%, RBtn%, MBtn%, HPosn%, VPosn%)π'*π'* Gets current mouse statusπ'* LBtn%, RBtn%, and MBtn% returnπ'* 1 if button is down or 0 if button is upπ'* HPosn% returns horizontal positionπ'* VPosn% returns vertical positionπ'*π  IF MouseReady% THENπ    MReg.AX = 3π    MouseCallπ    LBtn% = MReg.BX AND 1π    RBtn% = (MReg.BX AND 2) \ 2π    MBtn% = (MReg.BX AND 4) \ 4π    HPosn% = MReg.CXπ    VPosn% = MReg.DXπ  ELSEπ    LBtn% = 0: RBtn% = 0: MBtn% = 0π    HPosn% = -1: VPosn% = -1π  END IFπEND SUBππSUB MouseHideπ'*π'* Hide the mouse cursorπ'* Decrement the mouse cursor flagπ'* Cursor hidden if flag <> 0π'* MouseInit sets flag to -1π'*π  IF MouseReady% THENπ    MReg.AX = 2π    MouseCallπ  END IFπEND SUBππFUNCTION MouseInit%π'*π'* Initialize mouse and returnπ'* number of buttonsπ'* Return 0 if mouse driverπ'* unavailable or mouse notπ'* presentπ'*π  DEF SEG = 0π  Sum% = 0π  FOR I% = &H33 * 4 TO &H33 * 4 + 3π    Sum% = Sum% + PEEK(I%)π  NEXT I%π  IF Sum% = 0 THENπ    MouseInit% = 0π    EXIT FUNCTIONπ  END IFπ  MReg.AX = 0π  MouseCallπ  IF MReg.AX = 0 THENπ    MouseInit% = 0π  ELSEπ    MouseInit% = MReg.BXπ  END IFπEND FUNCTIONππSUB MouseReadCounters (HCount%, VCount%)π'*π'* Returns mouse movement relative toπ'* the last time this function was calledπ'* Measurements are in "mickeys". By default,π'* 1 mickey = 1 pixel horizontally andπ'* 2 mickeys = 1 pixel verticallyπ'*π  IF MouseReady% THENπ    MReg.AX = 11π    MouseCallπ    HCount% = MReg.CXπ    VCount% = MReg.DXπ  END IFπEND SUBππSUB MouseSetHorizRange (HMin%, HMax%)π'*π'* Sets the minimum and maximum horizontalπ'* range of the mouse cursor.π'* Moves the cursor inside the range if it'sπ'* outside.π'*π  IF MouseReady% THENπ    MReg.AX = 7π    MReg.CX = HMin%π    MReg.DX = HMax%π    MouseCallπ  END IFπEND SUBππSUB MouseSetPosn (HPosn%, VPosn%)π'*π'* Sets mouse cursor to HPosn and VPosnπ'*π  IF MouseReady% THENπ    MReg.AX = 4π    MReg.CX = HPosn%π    MReg.DX = VPosn%π    MouseCallπ  END IFπEND SUBππSUB MouseSetupπ'*π'* Setup to use mouseπ'* MUST be called beforeπ'* MouseInit or any otherπ'* mouse callsπ'*π  RESTORE MouseIntπ  DEF SEG = VARSEG(MouseRoutine%(0))π  Addr% = VARPTR(MouseRoutine%(0))π  FOR I = 0 TO 39π    READ A$π    POKE Addr% + I, VAL("&H" + A$)π  NEXT Iπ  IF A$ <> "CB" THEN ERROR 255π  DEF SEGπEND SUBππSUB MouseSetVertRange (VMin%, VMax%)π'*π'* Sets the minimum and maximum verticalπ'* range of the mouse cursorπ'* Moves the cursor inside the range if it'sπ'* outsideπ  IF MouseReady% THENπ    MReg.AX = 8π    MReg.CX = VMin%π    MReg.DX = VMax%π    MouseCallπ  END IFπEND SUBππSUB MouseShowπ'*π'* Display the mouse cursorπ'* Increments mouse cursor flagπ'* Cursor is displayed if flag is 0π'* MouseInit sets flag to -1π'*π  IF MouseReady% THENπ    MReg.AX = 1π    MouseCallπ  END IFπEND SUBππJohn Rodgers                   GRAPHICAL MOUSE USAGE          [e-mail]            03-04-96 (12:55)       QB, QBasic, PDS        402  10589    GRMOUSE.BAS '                         How to use the MOUSE in QBasicπ'                    note# the reusable button and box codeπ'              Mouse calls and code stolen from FIDO QuickBasic Subπ'                              John Rodgersπ'                             Too Cool Foolπ'                           Wizard ProductionsππDECLARE SUB chkInkey ()πDECLARE SUB typeSub ()πDECLARE SUB eye ()πDECLARE SUB review ()πDECLARE SUB getTime ()πDECLARE SUB winSub ()πDECLARE SUB drawButton (x, y, l$)πDECLARE SUB pushButton (x, y)πDECLARE SUB threeDbox (uRow%, uCol%, lRow%, lCol%)πCOMMON SHARED prTime$πCOMMON SHARED a$, text$πCOMMON SHARED row%, col%, rows%, cols%, outvππ'the  following mouse code and calls I stole off FIDO QuickBasic Sub, TCFπDEF SEG = 0πM.seg& = 256& * PEEK(207) + PEEK(206)πM.info% = 256& * PEEK(205) + PEEK(204) + 2ππ' see if a Mouse Driver is loadedπDEF SEG = M.seg&πIF (M.seg& OR (M.info% - 2)) AND PEEK(M.info% - 2) = 207 THENπ COLOR 0, 7π CLSππ SCREEN 11π LOCATE 12, 30π PRINT "Mouse Driver Not Found!"π LOCATE 14, 28π PRINT " Load the Mouse and re-try"π πEND IFπ'CALL absolute(0, 0, 0, 0, M.info%)  'Set Defaultsπ'CALL absolute(1, 0, 0, 0, M.info%)  'Turn on Pointerπ'CALL absolute(2, 0, 0, 0, M.info%)  'Turn off Pointerπ'CALL absolute(3, 0, 0, 0, M.info%)  'Statusπ'CALL absolute(4, 0, col%, row%, M.info%) 'Locate Pointerπ' in text mode Mickey reports 640 x 192π' Divide by 8 to use row and colπ πCALL absolute(0, 0, 0, 0, M.info%)  'Set Defaultπ SCREEN 9πCOLOR 8, 7πCLSπ πCALL absolute(1, 0, 0, 0, M.info%)πCALL absolute(4, 0, col% * 8, row% * 8, M.info%)ππdrawButton 2, 4, "A"πdrawButton 2, 10, "B"                    'draw buttonsπdrawButton 5, 4, "C"πdrawButton 5, 10, "L"πdrawButton 21, 36, "Q"ππthreeDbox 1, 2, 8, 16                   'drawboxesπthreeDbox 1, 20, 8, 60πthreeDbox 5, 61, 8, 79πthreeDbox 9, 27, 20, 79πthreeDbox 21, 22, 23, 34πthreeDbox 21, 1, 23, 19πthreeDbox 21, 42, 23, 54πthreeDbox 21, 57, 23, 71π  rows% = 10π DO                                   'main loopπ getTimeπthreeDbox 1, 2, 8, 16π CALL absolute(3, mbut%, xpos%, ypos%, M.info%)  'check on mouseπ LOCATE 22, 2π PRINT " Row"; (ypos% \ 8) + 1; "  "; "Col"; (xpos% \ 8) + 1π LOCATE 22, 23π PRINT " Button "; mbut%π  LOCATE 22, 59π PRINT "           "π                                                'if buttom pressedπ    'A                                                                                                               π IF (ypos% \ 8) + 1 = 5 AND (xpos% / 8) + 1 > 4 AND (xpos% / 8) + 1 < 8 AND mbut% = 0 THEN : LOCATE 22, 61: COLOR 14: PRINT "Message"π IF (ypos% \ 8) + 1 = 5 AND (xpos% / 8) + 1 > 4 AND (xpos% / 8) + 1 < 8 AND mbut% = 1 THENπ   pushButton 2, 4π  typeSubπ END IFπ   π  IF (ypos% \ 8) + 1 = 5 AND (xpos% / 8) + 1 > 4 AND (xpos% / 8) + 1 < 8 AND mbut% = 0 THENπ   drawButton 2, 4, ""π  END IFπ    'Bπ  IF (ypos% \ 8) + 1 = 5 AND (xpos% / 8) + 1 > 10 AND (xpos% / 8) + 1 < 14 AND mbut% = 0 THEN : LOCATE 22, 59: COLOR 14: PRINT "View Window"π  IF (ypos% \ 8) + 1 = 5 AND (xpos% / 8) + 1 > 10 AND (xpos% / 8) + 1 < 14 AND mbut% = 1 THENπ   pushButton 2, 10π   π   winSubπ  END IFπ  IF (ypos% \ 8) + 1 = 5 AND (xpos% / 8) + 1 > 10 AND (xpos% / 8) + 1 < 14 AND mbut% = 0 THENπ   drawButton 2, 10, ""π  END IFπ    'Cπ    IF (ypos% \ 8) + 1 = 10 AND (xpos% / 8) + 1 > 4 AND (xpos% / 8) + 1 < 8 AND mbut% = 0 THEN : LOCATE 22, 59: COLOR 14: PRINT "Clear Views"π  IF (ypos% \ 8) + 1 = 10 AND (xpos% / 8) + 1 > 4 AND (xpos% / 8) + 1 < 8 AND mbut% = 1 THENπ   pushButton 5, 4π   π  reviewπ  END IFπ  IF (ypos% \ 8) + 1 = 10 AND (xpos% / 8) + 1 > 4 AND (xpos% / 8) + 1 < 8 AND mbut% = 0 THENπ   drawButton 5, 4, ""π  π  END IFπ    'Lπ     IF (ypos% \ 8) + 1 = 10 AND (xpos% / 8) + 1 > 10 AND (xpos% / 8) + 1 < 14 AND mbut% = 0 THEN : LOCATE 22, 59: COLOR 14: PRINT "Show Logo"π  IF (ypos% \ 8) + 1 = 10 AND (xpos% / 8) + 1 > 10 AND (xpos% / 8) + 1 < 14 AND mbut% = 1 THENπ   pushButton 5, 10π   eyeπ  END IFπ  IF (ypos% \ 8) + 1 = 10 AND (xpos% / 8) + 1 > 10 AND (xpos% / 8) + 1 < 14 AND mbut% = 0 THENπ   drawButton 5, 10, ""π π  END IFπ    'Qπ     IF (ypos% \ 8) + 1 = 38 AND (xpos% / 8) + 1 > 36 AND (xpos% / 8) + 1 < 40 AND mbut% = 0 THENπ     LOCATE 6, 62π     COLOR 14π     PRINT "**** Click Q ****"     'this gets printed if the cursor goes across the "Q" buttonπ     LOCATE 7, 62π    PRINT "**** to QUIT ****"π    END IFπ  IF (ypos% \ 8) + 1 = 38 AND (xpos% / 8) + 1 > 36 AND (xpos% / 8) + 1 < 40 AND mbut% = 1 THENπ  outv = 1π  END IFπ  IF (ypos% \ 8) + 1 = 10 AND (xpos% / 8) + 1 > 10 AND (xpos% / 8) + 1 < 14 AND mbut% = 0 THENπ   drawButton 5, 10, ""ππ  END IFπ  a$ = INKEY$π   π ' a$ = "s"π  IF LEN(a$) THEN chkInkey        'keyboard inputπ' LOCATE 7, 62π' PRINT rows%; " "; cols%π LOOP UNTIL outv = 1              'exitπLOCATE 12, 2πCOLOR 8, 0π                                 'bragπPRINT "    Works. Don't it?   "πFOR T = 1 TO 30000πNEXTπFOR T = 1 TO 30000πNEXTππSYSTEMππSUB chkInkey           'controls user inputπ STATIC rows%π IF rows% = 0 AND rows% < 11 THEN rows% = 10π    SELECT CASE a$                                   'inputππ   CASE CHR$(8)   'backspaceπ    IF fields = 4 AND LEN(text$) = 6 THENπ   π      LOCATE rows%, 30 + LEN(text$)π      π      text$ = LEFT$(text$, (LEN(text$) - 1))π     ELSEπ     LOCATE rows%, 30 + LEN(text$)                  'black out entire stringπ     PRINT STRING$(LEN(text$), " ")π    END IFππ     a$ = ""                                  'clear a$π     'ON ERROR GOTO eror:π    IF LEN(text$) - 1 >= 0 THENπ      text$ = LEFT$(text$, LEN(text$) - 1)         'reprint shortened text$π     END IFππ π  CASE CHR$(13)   'carrage returnππ      typeSubπ      eyeπ      winSubππ    rows% = rows% + 1π    text$ = ""π    π  CASE CHR$(27)   'escapeππ     π   outv = 1πEND SELECTπtext$ = text$ + a$πIF LEN(text$) >= 46 THEN BEEP: text$ = LEFT$(text$, 46)π   cols% = 29π   LOCATE rows%, 29πPRINT text$πππEND SUBππSUB drawButton (x, y, l$)π                           'draws a button at x and y with a letter l$πCOLOR 15πLOCATE x, yπPRINT "┌───"πLOCATE x + 1, yπPRINT "│"; " "; l$πLOCATE x + 2, yπPRINT "└"πCOLOR 8πLOCATE x, y + 4πPRINT "┐"πLOCATE x + 1, y + 4πPRINT "│"πLOCATE x + 2, y + 1πPRINT "───┘"πEND SUBππSUB eye                    'draws my logoππLINE (500, 8)-(605, 35), 8, BFπLINE (499, 7)-(606, 36), 4, BπCIRCLE (550, 20), 32, 14, , , 2 / 9πPAINT STEP(0, 0), 14πCIRCLE STEP(0, -1), 11, 8πPAINT STEP(0, 0), 8, 8πCIRCLE STEP(1, 1), 1, 12πSTATIC TπT = T + 1πIF T >= 14 THEN T = 0πCOLOR TππLOCATE 4, 62πPRINT "Wizard Productions"πEND SUBππSUB getTimeππ           'convert SYSTEM time and date to prTime$ and prDate$π                        'for program useπT$ = TIME$πHr = VAL(T$)πIF Hr < 12 THEN Ampm$ = " AM" ELSE Ampm$ = " PM"πIF Hr > 12 THEN Hr = Hr - 12πIF Hr = 0 THEN Hr = 12ππ prgTime$ = STR$(Hr) + RIGHT$(T$, 6) + Ampm$πππ IF Ampm$ = " AM" THEN                        ' convert prgTime$ to 5 charactersππprTime$ = LEFT$(prgTime$, 5) + " AM"                'for AMπ END IFππ IF Ampm$ = " AM" AND VAL(LEFT$(prgTime$, 3)) >= 10 THEN ' convert prgTime$ to 6 charactersπ prTime$ = LEFT$(prgTime$, 6) + " AM"                'for PM after 10π END IFπ IF Ampm$ = " PM" THEN                          ' convert prgTime$ to 5 charactersπprTime$ = LEFT$(prgTime$, 5) + " PM"                 'for PMπ END IFππ IF Ampm$ = " PM" AND VAL(LEFT$(prgTime$, 3)) >= 10 THEN ' convert prgTime$ to 6 charactersπprTime$ = LEFT$(prgTime$, 6) + " PM"               'for PM after 10π END IFππCOLOR 15, 11πLOCATE 22, 43        '  PRINT prTime$πPRINT LTRIM$(prTime$); " "; RIGHT$(TIME$, 2)π   ππ  πππEND SUBππSUB pushButton (x, y)π               'show a double line button at x and yπ                'while mouse button is pressedπ COLOR 8πLOCATE x, yπPRINT "╔═══"πLOCATE x + 1, yπPRINT "║ "πLOCATE x + 2, yπPRINT "╚"πCOLOR 15πLOCATE x, y + 4πPRINT "╗"πLOCATE x + 1, y + 4πPRINT "║"πLOCATE x + 2, y + 1πPRINT "═══╝"ππEND SUBππSUB reviewπVIEWπCLS                     'clears and redraws screen DO NOT DO THISπ                            'very kludgeyπthreeDbox 1, 2, 8, 16πthreeDbox 1, 20, 8, 60πthreeDbox 5, 61, 8, 79πthreeDbox 9, 27, 20, 79πthreeDbox 21, 22, 23, 34πthreeDbox 21, 1, 23, 19πthreeDbox 21, 42, 23, 54πthreeDbox 21, 57, 23, 71πdrawButton 2, 4, "A"πdrawButton 2, 10, "B"πdrawButton 5, 4, "C"πdrawButton 5, 10, "L"πdrawButton 21, 36, "Q"π πEND SUBππSUB threeDbox (uRow%, uCol%, lRow%, lCol%)π COLOR 8π   ' Draw top of box.π  LOCATE uRow%, uCol%: PRINT CHR$(218);π   LOCATE , uCol% + 1: PRINT STRING$(lCol% - uCol%, CHR$(196));π   LOCATE , lCol%: PRINT CHR$(191);ππ   ' Draw body of box.π   FOR i = uRow% + 1 TO lRow% - 1π   COLOR 8π      LOCATE i, uCol%: PRINT CHR$(179);π      COLOR 15π      LOCATE , lCol%: PRINT CHR$(179);π   NEXT iππ   ' Draw bottom of box.π            LOCATE lRow%, uCol%: PRINT CHR$(192);π   LOCATE , uCol% + 1: PRINT STRING$(lCol% - uCol%, CHR$(196));π   LOCATE , lCol%: PRINT CHR$(217);πππEND SUBππSUB typeSub            'types a message to the screen with an annoying noiseπSTATIC T, eπT = T + 1πIF T >= 14 THEN T = 0πCOLOR Tπ πa$ = "This is a demonstration of the "        'define stringsπb$ = "possibilities of mouse support when"πc$ = " added to programs in MS QBasic"πd$ = "Too Cool Fool"πFOR w = 1 TO LEN(a$)                'print each string one letter at a timeπSOUND 200, .1                           'annoying noiseπLOCATE 3, 25πPRINT LEFT$(a$, w)πFOR q = 1 TO 500πNEXT q                                  'lousy way to do this but I wasπNEXT                                      'havin' funπFOR w = 1 TO LEN(b$)πSOUND 200, .1πLOCATE 4, 23πPRINT LEFT$(b$, w)πFOR q = 1 TO 500πNEXT qπNEXTπFOR w = 1 TO LEN(c$)πSOUND 200, .1πLOCATE 5, 24πPRINT LEFT$(c$, w)πFOR q = 1 TO 500πNEXT qπNEXTπCOLOR 14πSOUND 440, 1πFOR w = 1 TO LEN(d$)πSOUND 240 + w, 1ππLOCATE 6, 33πPRINT LEFT$(d$, w)πFOR q = 1 TO 500πNEXT qπNEXTπππEND SUBππSUB winSubπSTATIC a                       'another pointless subπa = a + 1πIF a >= 16 THEN a = 1πVIEW (10, 130)-(195, 270), a, 9πLOCATE 11, 2πCOLOR a, aπ πPRINT " This is a view window  "πwinText$ = text$πIF LEN(text$) >= 24 THENπwinText$ = LEFT$(text$, 24) + CHR$(13) + MID$(text$, 25, (LEN(text$) - 24))πEND IFπLOCATE 12, 2πPRINT winText$πFOR T = 1 TO 300πNEXT TπEND SUBππBrian Roche                    GRAPHICAL MOUSE CURSORS DEMO   FidoNet QUIK_BAS Echo          03-08-96 (00:13)       QB, PDS, VBDOS         361  12931    MEESES.BAS  'π'           M e e s e s  .  B a s      from B. Rocheπ'π'              Demonstrates Graphical Mouse Cursorsπ'             Translated over from VBDOS Programπ'     Make sure to enter Environment with /L for Interrupt Supportππ'   Currently set up to run *AS IS* in QB ..REM/UNREM the appropriateπ'                   spots to use Far Strings ..ππ'    Multiple Versions of some Cursors are given because some lookπ'          Better on White BG, some better on Black BGπππDECLARE FUNCTION HaveMouse% ()      ' Checks to See if Driver InstalledπDECLARE SUB PrintR (A$, X%, Y%, StepX%, StepY%, CO%, BackGround%, Shadow%)π        ' Prints Text in Graphics Mode 12πDECLARE SUB ChangeCursor (A$)       ' Changes Graphics Mouse CursorπDECLARE SUB Mouse (M0, M1, M2, M3)  ' Mouse DriverπDECLARE SUB MouseShow ()            ' Displays Mouse CursorπDECLARE SUB MouseHide ()            ' Hides Mouse Cursorπππ ' $INCLUDE: 'QB.BI'         ' Use for QB45 (Keep at least One REM here!)π REM '$INCLUDE: 'VBDOS.BI'π ' Use 'VBDOS.BI' for VBDOS, 'QBX.BI' for PDSππDIM Regs AS RegType          ' Interrupt needed for Regular Mouse Routines,π                             ' QB also uses Interrupt for Mouseπ                             ' Cursor RoutinesπREM 'DIM RegsX AS RegTypeX   ' InterruptX needed for PDS/VBDOSπ                             ' Far Strings, but both Interrupt callsπ                             ' Still needed for QBX/VBDOSπππON ERROR GOTO NOVGA:         ' Make sure we've got VGA ..π SCREEN 12πON ERROR GOTO 0ππ  ' Now Blank the Monitor while Drawing the Screen ..π  OUT &H3C4, 1: CMR% = INP(&H3C5): OUT &H3C5, CMR% OR &H20π  LINE (0, 0)-(640, 480), 7, BF     ' Use a White backGroundπ  LINE (320, 20)-(600, 305), 0, BF  ' Black "Window" to also check Cursorsππ ' Yeah, I know using DATA statements is not an example ofπ ' Programming Virtuosity, but this is just Demo code ...π FOR I% = 1 TO 14π  READ Prompt$π  Prompt$ = CHR$(I% + 64) + ") " + Prompt$π  PrintR Prompt$, 25, I% * 20 + 5, 8, 0, 15, 7, 1π NEXTππ Prompt$ = "Q) Quit program."π PrintR Prompt$, 25, 305, 8, 0, 15, 7, 1ππ Prompt$ = "Press the Letter of the Cursor you want, or <Q> to Quit."π PrintR Prompt$, 45, 400, 8, 0, 11, 7, 1π Prompt$ = ""πππ  ' Now that the screen is Drawn, Turn the Screen back on..π  OUT &H3C4, 1: CMR% = INP(&H3C5): OUT &H3C5, CMR% AND &HDFππ  ' And Check for the Rodent ...π IF HaveMouse% THEN               ' Check For Mouse Driverπ   Mouse 0, 0, 0, 0               ' Initialize Mouseπ   MouseShow                      ' Show Mouse Cursorπ ELSEπ   SCREEN 0π   LOCATE 15, 28: PRINT "You need a Mouse for a Mouse Cursor Program, Silly!"π   WHILE INKEY$ = "": WENDπ   SYSTEMπ END IFπππ ' Now Run a Loop, Checking Input, and Change the Mouse Cursor accordingly ..π  DOπ    DO: A$ = INKEY$: LOOP UNTIL LEN(A$)π    A$ = UCASE$(A$)π    IF A$ = "Q" THENπ      MouseHideπ      SCREEN 0, , 0, 0: SYSTEMπ    END IFπ    IF A$ >= "A" AND A$ <= "N" THEN ChangeCursor A$π  LOOPπππNOVGA:    ' VGA Error Trapπ  SCREEN 0, , 0, 0π  LOCATE 15, 25: PRINT "You Must have a VGA to run this program"π  SYSTEMπππ' Menu Data ...πDATA "Bulls Eye Cursor #1","Bulls Eye Cursor #2"πDATA "Hour Glass Cursor #1","Hour Glass Cursor #2"πDATA "Hour Glass Cursor #3", "Hour Glass Cursor #4"πDATA "Hour Glass Cursor #5","Stop Watch Cursor"πDATA "Smiley Face Cursor", "Smiley Face Cursor #2"πDATA "Cross Hair Cursor", "Cross Hair Cursor #2"πDATA "Pointing Hand Cursor","Pointing Hand Cursor #2"πππ'---------------- Start of Mouse Cursor Data ----------------πBullsEye1:πDATA &HFFFF,&HFFFF,&HFFFF,&HFFFF,&HFFFF,&HFFFF,&HFFFF,&HFFFFπDATA &HFFFF,&HFFFF,&HFFFF,&HFFFF,&HFFFF,&HFFFF,&HFFFF,&HFFFFπDATA &HFFFF,&H8001,&H8001,&H8001,&H8FF1,&H8811,&H8811,&H8811πDATA &H8811,&H8811,&H8811,&H8FF1,&H8001,&H8001,&H8001,&HFFFFπDATA 7,0π'------------------ End of Mouse Cursor Data ------------------ππ'---------------- Start of Mouse Cursor Data ----------------πBullsEye2:πDATA &H0,&H0,&H0,&H0,&HFF0,&HFF0,&HFF0,&HFF0πDATA &HFF0,&HFF0,&HFF0,&HFF0,&H0,&H0,&H0,&H0πDATA &H0,&H7FFE,&H7FFE,&H6006,&H6006,&H6006,&H6006,&H6006πDATA &H6006,&H6006,&H6006,&H6006,&H6006,&H7FFE,&H7FFE,&H0πDATA 7,8π'------------------ End of Mouse Cursor Data ------------------ππ'---------------- Start of Mouse Cursor Data ----------------πHourGlass1:πDATA &HFFFF,&HFFFF,&HFFFF,&HFFFF,&HFFFF,&HFFFF,&HFFFF,&HFFFFπDATA &HFFFF,&HFFFF,&HFFFF,&HFFFF,&HFFFF,&HFFFF,&HFFFF,&HFFFFπDATA &HFFFF,&H2004,&H2004,&H2004,&H1008,&H990,&H420,&H240πDATA &H240,&H420,&H810,&H1008,&H2084,&H2144,&H22A4,&HFFFFπDATA 5 ,0π'------------------ End of Mouse Cursor Data ------------------ππ'---------------- Start of Mouse Cursor Data ----------------πHourGlass2:πDATA &H0,&HDFFB,&HDFFB,&HDFFB,&HEFF7,&HF66F,&HFBDF,&HFDBFπDATA &HFDBF,&HFBDF,&HF7EF,&HEFF7,&HDF7B,&HDE3B,&HDC1B,&H0πDATA &H0,&H0,&H0,&H0,&H0,&H0,&H0,&H0πDATA &H0,&H0,&H0,&H0,&H0,&H0,&H0,&H0πDATA 5 ,0π'------------------ End of Mouse Cursor Data ------------------ππ'---------------- Start of Mouse Cursor Data ----------------πHourGlass3:πDATA &H0,&HC003,&HC003,&HC003,&HE007,&HF00F,&HF81F,&HFC3FπDATA &HFC3F,&HF81F,&HF00F,&HE007,&HC003,&HC003,&HC003,&H0πDATA &H400,&H1FF8,&H1FF8,&H1FF8,&HC30,&H660,&H3C0,&H180πDATA &H180,&H3C0,&H7E0,&HFF0,&H1E78,&H1C38,&H1818,&H0πDATA 5 ,0π'------------------ End of Mouse Cursor Data ------------------ππ'---------------- Start of Mouse Cursor Data ----------------πHourGlass4:πDATA &H0,&H8001,&H8001,&H8001,&HA185,&HB00D,&HB81D,&HBC3DπDATA &HBC3D,&HB81D,&HB00D,&HA005,&H8181,&H83C1,&H87E1,&H0πDATA &H0,&H1FF8,&H1FF8,&H1FF8,&HC30,&H660,&H3C0,&H180πDATA &H180,&H3C0,&H7E0,&HFF0,&H1E78,&H1DB8,&H1FF8,&H0πDATA 5 ,0π'------------------ End of Mouse Cursor Data ------------------ππ'---------------- Start of Mouse Cursor Data ----------------πStopWatch:πDATA &HFFFF,&HFFFF,&HFFFF,&HFFFF,&HFFFF,&HFFFF,&HFFFF,&HFFFFπDATA &HFFFF,&HFFFF,&HFFFF,&HFFFF,&HFFFF,&HFFFF,&HFFFF,&HFFFFπDATA &H3000,&H63E0,&HDC18,&H1004,&H2002,&H2602,&H4301,&H4181πDATA &H40C1,&H4081,&H4081,&H2082,&H2082,&H1004,&HC18,&H3E0πDATA 1 ,1π'------------------ End of Mouse Cursor Data ------------------ππ'---------------- Start of Mouse Cursor Data ----------------πSmiley1:πDATA &HFFFF,&HFFFF,&HFFFF,&HFFFF,&HFFFF,&HFFFF,&HFFFF,&HFFFFπDATA &HFFFF,&HFFFF,&HFFFF,&HFFFF,&HFFFF,&HFFFF,&HFFFF,&HFFFFπDATA &HE70,&H1FE8,&H3C3C,&H381C,&H6006,&H8422,&H8421,&H8001πDATA &H8181,&H9011,&H4822,&H43C2,&H2004,&H100C,&H399C,&H700EπDATA 5 ,0π'------------------ End of Mouse Cursor Data ------------------ππ'---------------- Start of Mouse Cursor Data ----------------πSmiley2:πDATA &HE70,&H1FE8,&H3C3C,&H381C,&H6006,&H8422,&H8421,&H8421πDATA &H8001,&H9191,&H4812,&H4422,&H23C4,&H1008,&H399C,&H700EπDATA &HF18F,&HE017,&HC3C3,&HC7E3,&H9FF9,&H7BDD,&H7BDE,&H7BDEπDATA &H7FFE,&H6E6E,&HB7ED,&HBBDD,&HDC3B,&HEFF7,&HC663,&H8FF1πDATA 5 ,0π'------------------ End of Mouse Cursor Data ------------------ππ'---------------- Start of Mouse Cursor Data ----------------πCrossHair1:πDATA &HFFFF,&HFFFF,&HFFFF,&HFFFF,&HFFFF,&HFFFF,&HFFFF,&HFFFFπDATA &HFFFF,&HFFFF,&HFFFF,&HFFFF,&HFFFF,&HFFFF,&HFFFF,&HFFFFπDATA &H100,&H100,&H100,&H100,&H100,&H100,&H100,&H100πDATA &HFFFE,&H100,&H100,&H100,&H100,&H100,&H100,&H100πDATA 7 ,0π'------------------ End of Mouse Cursor Data ------------------ππ'---------------- Start of Mouse Cursor Data ----------------πCrossHair2:πDATA &HFFFF,&HFC7F,&HFC7F,&HFC7F,&HFC7F,&HFC7F,&HFC7F,&H1πDATA &H101,&H1,&HFC7F,&HFC7F,&HFC7F,&HFC7F,&HFC7F,&HFC7FπDATA &H0,&H0,&H100,&H100,&H100,&H100,&H100,&H0πDATA &H7C7C,&H0,&H100,&H100,&H100,&H100,&H100,&H0πDATA 7 ,0π'------------------ End of Mouse Cursor Data ------------------ππ'---------------- Start of Mouse Cursor Data ----------------πHand1:πDATA &HF3FF,&HEDFF,&HEDFF,&HEC7F,&HED8F,&HEDB1,&HEDB6,&H8DB6πDATA &H6DB6,&H6FFE,&H6FFE,&H7FFE,&H7FFE,&H7FFE,&HBFFD,&HC003πDATA &HC00,&H1200,&H1200,&H1380,&H1270,&H124E,&H1249,&H7249πDATA &H9249,&H9001,&H9001,&H8001,&H8001,&H8001,&H4002,&H3FFCπDATA 5 ,0π'------------------ End of Mouse Cursor Data ------------------ππ'---------------- Start of Mouse Cursor Data ----------------πHand2:πDATA &HF3FF,&HE1FF,&HE1FF,&HE07F,&HE00F,&HE001,&HE000,&H8000πDATA &H0,&H0,&H0,&H0,&H0,&H0,&H8001,&HC003πDATA &H0,&HC00,&HC00,&HC00,&HD80,&HDB0,&HDB6,&HDB6πDATA &H6DB6,&H6FFE,&H6FFE,&H7FFE,&H7FFE,&H7FFE,&H3FFC,&H0πDATA 5 ,0π'------------------ End of Mouse Cursor Data ------------------ππSUB ChangeCursor (A$)π  DIM Regs AS RegType          ' Use for QB45 Near Stringsπ  REM DIM Regs as RegTypeX     ' Use for QBX/VBDOS Far Stringsππ  ' Assigns Custom Cursor Shape Depending on String Passed.π  ' Use RegType in QB; need ES Register for PDS/VBDOS Far String support.ππ  SELECT CASE A$π  CASE "A"π     RESTORE BullsEye1:π  CASE "B"π     RESTORE BullsEye2:π  CASE "C"π     RESTORE HourGlass1:π  CASE "D"π     RESTORE HourGlass2:π  CASE "E"π     RESTORE HourGlass3:π  CASE "F"π     RESTORE HourGlass4:π  CASE "G"π     RESTORE HourGlass4:π  CASE "H"π     RESTORE StopWatch:π  CASE "I"π     RESTORE Smiley1:π  CASE "J"π     RESTORE Smiley2:π  CASE "K"π     RESTORE CrossHair1:π  CASE "L"π     RESTORE CrossHair2:π  CASE "M"π     RESTORE Hand1:π  CASE "N"π     RESTORE Hand2:π  CASE "Q:"π     SCREEN 0, , 0, 0π     CLS : SYSTEMπ  CASE ELSEπ     EXIT SUBπ  END SELECTππ  '====================================================================π  ' Below is the part you're most interested in. I read it in as aπ  ' String * 1 (BYTE) .. 16 Bytes for the Cursor Mask, 16 Bytes forπ  ' the Screen Mask, and the last two Integers the location of the Cursorπ  ' Hot Spot - the Point actually referenced in Mouse Coordinates.ππ  ' Read in Graphical Mouse Cursor Dataπ  FOR I% = 1 TO 32π    READ Wrd%π    MMsk$ = MMsk$ + MKI$(Wrd%)         ' Cursor Graphical Dataπ  NEXT I%π  READ Hotx, Hoty                      ' Cursor HotSpotππ  ' Now For the Interrupt call ..π  ' Use Function 9 from Int 33 ..π  Regs.ax = 9: Regs.bx = Hotx: Regs.cx = Hotyπ  Regs.dx = SADD(MMsk$)   ' Use with ALL Basics ..ππ  ' Next Line not needed for QB, (Optional for PDS ??), needed for VBDOSπ  ' But using it stores Data as a Far String.π  REM Regs.es = SSEG(MMsk$)  ' Need InterruptX for this One ..ππ  INTERRUPT &H33, Regs, Regs        ' Call QB45 Near string Interruptπ  REM INTERRUPTX &H33, Regs,Regs    ' Call VBDOS/PDS Far String InterruptπEND SUBππFUNCTION HaveMouse%π  ' Checks to see if Mouse is Installedπ  DEF SEG = 0π  MouseSegment& = 256& * PEEK(207) + PEEK(206)π  MouseOffset& = 256& * PEEK(205) + PEEK(204)ππ  DEF SEG = MouseSegment&π  IF (MouseSegment& = 0 AND MouseOffset& = 0) OR PEEK(MouseOffset&) = 207 THENπ    HaveMouse% = 0π  ELSEπ    HaveMouse% = 1π  END IFπ  DEF SEGπEND FUNCTIONππSUB Mouse (M0, M1, M2, M3) STATICπ  ' Note: VBDOS will move the "STATIC" in front of this SUB Name.π  ' If you then go back into QB, you'll have to manually put the "STATIC"π  ' back at the end of the Sub Declaration, or generate an Error.ππ  ' M0 = 0 : Initialize the Rodentπ  '      1 - Show Mouseπ  '      2 - Hide Mouseπ  '      3 - Mouse Location/Button Statusππ  DIM Regs AS RegType           ' Use for ALL Basic's ..π  ' Calls interrupt &H33 to invoke mouse functions in the MS Mouse Driver.ππ  Regs.ax = M0: Regs.bx = M1: Regs.cx = M2: Regs.dx = M3π  INTERRUPT &H33, Regs, Regs              ' Use for ALL Basic's ..π  M0 = Regs.ax: M1 = Regs.bx: M2 = Regs.cx: M3 = Regs.dxπEND SUBππSUB MouseHide                   ' Hides Mouse cursorπ  Mouse 2, 0, 0, 0πEND SUBππSUB MouseShow                   ' Shows mouse Cursorπ  Mouse 1, 0, 0, 0πEND SUBππSUB PrintR (A$, X%, Y%, StepX%, StepY%, CO%, BackGround%, Shadow%)π  ' Prints Graphical Chars from Rom Data Tableπ  ' A$ Param is string to printπ  ' X%=Graphics Horz pixel Positionπ  ' Y%=Graphics Vert pixel Positionπ  ' StepX% and StepY% control size of charsπ  ' CO%= Foreground colorπ  ' BackGround%= BackGround Colorπ  ' Shadow% is a Boolean for Shadow enablingππ  ExtX% = StepX%: ExtY% = StepY%π  DEF SEG = &HFFA6        ' ROM Segment for Character Shape Tablesπ  FOR I% = 1 TO LEN(A$)π    Addr% = 8 * ASC(MID$(A$, I%)) + 14     'Address character shape tableπ    IF BackGround% THEN                    'Color backgroundπ    IF BackGround% = 256 THEN BG% = FALSE ELSE BG% = BackGround%π    IF I% = LEN(A$) THEN ExtX% = FALSE: ExtY% = FALSEπ    LINE (X%, Y%)-(X% + 7 + ExtX%, Y% + 7 + ExtY%), BG%, BFπ    END IFπ    FOR J% = 0 TO 7π    Mask% = PEEK(Addr% + J%) * 128π    IF Shadow% THENπ    LINE (X% + 9, Y% + J% + 2)-(X% + 2, Y% + J% + 2), 0, , Mask%π    END IFπ   LINE (X% + 7, Y% + J%)-(X%, Y% + J%), CO%, , Mask%π  NEXTπ  X% = X% + ExtX%π  Y% = Y% + ExtY%π  NEXTπ  DEF SEG                 'Back to DGROUPπEND SUBπDave Shea                      PSYCHADELIC ELVIS MOUSEBOY     FidoNet QUIK_BAS Echo          03-09-96 (13:45)       QB, PDS                69   2557     ELVIS.BAS   'Psychadelic Elvis MouseBoy - By Dave Sheaππ'This is a little demonstation to show you how to customize your mouseπ'cursor. Alter it, use it, destroy it, do whatever you want with it. Justπ'remember to credit me at least a little bit, eh? Just remember you're usingπ'this at your own risk... If it radiates your cat, don't blame me....ππ'These following lines initiate the mouse setup. Sorry, can't remember whatπ'everything does... :(ππ'$INCLUDE: 'qb.bi'πDIM Cursor%(1000): DIM MaskCursor%(1000): DIM Back%(1000)πDIM inreg AS RegType: DIM outreg AS RegType: inreg.ax = 0πCALL INTERRUPT(&H33, inreg, outreg)πhmin% = 1: hmax% = 290: inreg.cx = hmin%: inreg.dx = hmax%: inreg.ax = 7πCALL INTERRUPT(&H33, inreg, outreg)πvmin% = 1: vmax% = 170:  inreg.cx = vmin%: inreg.dx = vmax%: inreg.ax = 8πCALL INTERRUPT(&H33, inreg, outreg)πinreg.cx = 0: inreg.dx = 0: inreg.ax = 4πCALL INTERRUPT(&H33, inreg, outreg)πππCLS : SCREEN 13                           'I sure as heck hope I don't needπDEFINT A-B                                'to explain THIS....ππ'This draws & GETS my funky Elvis look-alikeππPSET (16, 7)πDRAW "c161nr2dnrlnd2rdc66rc1dc66nrl1drgdc15nenhr3c66rlc15l3"πDRAW "l3c66lrc15r3dnrnldnrnld"πDRAW "c16nrnlc44dc1nrld3c161nluc1u2r2d3c161nr "πGET (5, 4)-(28, 24), Cursor%ππ'This draws & GETS a mask of my funky Elvis look-alikeπ'This is vital, as creating a mask will allow you to place the cursor overπ'a background without totally destroying it.ππFOR a = 1 TO 30π FOR B = 1 TO 30π  IF POINT(a, B) = 0 THEN PSET (a, B), 255π  IF POINT(a, B) <> 0 AND POINT(a, B) <> 255 THEN PSET (a, B), 0π NEXTπNEXTπGET (5, 4)-(28, 24), MaskCursor%ππCLSπx = 160: y = 100πFOR a = 1 TO 200                     'Shnazzy Background setup-sequenceπ LINE (1, a)-(320, a), aπNEXTππmouseloop:πGET ((x - 1) / 2, y)-((x - 1) / 2 + 25, y + 25), Back% 'Get temp backgroundπPUT ((x - 1) / 2, y), MaskCursor%, AND                 'Lay down the maskπPUT ((x - 1) / 2, y), Cursor%, XOR                     'Overlap with ElvisπWAIT 986, 8                                            'Vertical retraceπPUT ((x - 1) / 2, y), Back%, PSET                      'Restore BackGroundππ'get mouse location and statusπ'if outreg.bx=1 then left button is pushedπ'if outreg.bx=2 then right button is pushedπ'if outreg.bx=3 then both buttons have been pushedπinreg.ax = 3πCALL INTERRUPT(&H33, inreg, outreg)πx = outreg.cx + 1πy = outreg.dx + 1πIF outreg.bx = 1 THEN PSET ((x - 1) / 2, y), 4πIF outreg.bx = 3 THEN ENDπGOTO mouseloopπDave Shea                      ANIMATED MOUSE CURSOR          FidoNet QUIK_BAS Echo          03-30-96 (00:00)       QB, PDS                46   2849     MOUSANIM.BAS'Well, I sat down and wrote me a program that'll give you an animatedπ'mouse cursor.ππDEFINT A-Z:DIM SHARED K,S,B&,Z&:V1 'Created by PostIt! 7.2πSUB V1:OPEN "O",1,"MOUSANIM.ZIP",4^6:Z&=1787:?STRING$(50,177);πU"%up()%9%%%I-%[L8PE*T=Ea0(7%%)2%%%1%%%%rt%zxjf%srSgRfx&%;<>Sms5wπU"7KEwVvCUN?$scWn#*&io)qARi%P>r4([c1:O*Cx;]Au8wo>:I:Pu&_GIYZle\6oπU"?$,,,=uV=2DV^brHT?H0i_[#s=n5wb/]h$fc3rg\?+SE93xH#%&VU?sdsib6WaiπU"?[5<%3a4Lp1kT:7KZ])NA80t*Y02_mWbfc=V42#lC\+a)BeDLH7)/$+4f9aARUYπU"C6t_#jO/kpQu-WXm*cUZ**l8F$tv'O;cRBd-qXpHK,[OP*S>rP75>960_d:Sj=9πU"2S>m47r0w'aBw)cq7//'>i-&%NMcHbCpTry/;w0xJdrz;))0#OWTw+\a/TyRM5dπU"<%rQeC/hy;z;T/z/,b4T:/c<Q=n]#x-Z5efPd:+yd=1&VQb>3iO'4=m0WUC[u5SπU"ofQ1nZ_qp'W-KX.CtOqlR+91G.7WAP6MzQh[,r:Vr\5N;K[]dixl+$SqLHwYDJ.πU"6uM4abLX9-C0v>DTcG>>.7TsG>9nTG:pkbGI3lL>db\CHa8S&=putb7P&f,[sHOπU"J8CJ5U\m6uPfmbqbK(&R*^xS/2?j;K)?U%w+IkM\VCbCj;VZ/A-a*cEkEX\3=n.πU"rd/#4tb2VGb?A7pZ6bm#?[lm2:rA-GqneI\iVFn'?\xKIC4%5u_j36%*\WnSkn\πU"S8jcZ5)T\K60TSWKk.l7cbE+_-2Kg6$\u<ooMG3Qp<_rDCHgPx;XFxR;xg5vkC$πU"ofy/<8sKc1bdfzUU^Y(leoK,cGKZu=#$D]DPK>deAxAI=pjnwt;l]Q+GaOrM.+[πU"EnSbSU0::_;nK+c;IPl-ZG%X6\F&&P5NibvBmt=tD^'rF$#4^o+1ckSt:M$LlJIπU"ay+]s/i-7YX8%)$23H8ga7,dxk\?T2ZD1C/Hq5'ITnP?Sm1[Fb%r:N.xq<+AP[3πU"n:#.S2Uq<CBP[4:Yj.Su_q<BPK/3:*Q.Seqn<DP/p4:T.lS/qf4APE3n:$.Sq]qπU"VwZY5TYcoF,hoprbe2K?r5n,zxFoJa4>_XI[B#lBs[cwg1=YLRd7<IEDDM&;Z+WπU"QN$ctd=eK-=06k124Y7B_C#r0k'dHTuNCZa&7o$IfCvXo1V,[r?;=X2ZxJBEg=.πU"nTd.%qKh^Sj:a6]]_Rfr/&[;zSkdUDuc-ubRb_]UFAf*\R54)\ES[=5N^kHj\N=πU"ZQB8ZUlBaDh=607hZ'e1*MDqTZD*ZhjcLa#,G5\,[=v%4up(%)9%%#%-%^\SxERπU"H95]?%'%%,'s%%,%%%%r%fsSfmsrfT;,ASU#9+u<c=9Sk[ORN%qw:b+O_Lhinn+πU"B\'dEq(aY$a_p#(k#kDisL-XbloEb&'-9S[mBSr#sZ_R>=nuLXvsZTh<LJmdIKPπU"NtLXroHwaF>sP>ZNjSRCdLYEY*F_2GmX7N]3tDfp<%bheyMkSTdl,.36uH&P9pHπU"TpMK-(u(/X#;ik#8J;Tn?H6HNiXb;Vr9-RDvhm^iPNX:*>Vi,N.dcCp3,+.tc(kπU"x)ve+wXgA8Fo2u+FVJEZQfc<[9DI?cPo\u8H*86cjgqswIsjD$YCku>r4sMEvzAπU"fh*v0lU()l7[/?JJ];%Lm7jNWPE:ta6[JkkKvS:EQ4qCFk^?3pA4v>r9utt#,]vπU"BsR6Y**tW[w[t75TVIXit\9sBP1p^^X8ff0%,KHF[rlap.G?Zh8w=stFkbxCSJ#πU"5l0z9GtvgdyDrXKoaLNL\nHN<Rk;Trb>u?^.i=C$b4HH1cXVMca(Aog/q8.fvK:πU"_FoSQ[i_ulEsPtT/=B.vZ^BLi<qHj1SERacZ=3N_$<oFrcH($T[*??xLM<NjpJMπU"bwr?j#<UoEi$+:S(tKm<i<*'SMO0Lv8rMrZib:HvvyNrsJ7wP=sFy'xZ'%R%%YDπU"ouqahGPvN?V,Ls*D&n+&$/vclcpQ&M?Y3s7D:UtN=+i:8Yw:Tz?LYs/78P#tqT:πU"CL'Zboqo%=9=N3v&RZvffDZ1+=uf:inj;N58Lump)s$mvdvfbtNaptN(^3v,L%%πU"%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%#%%%n'q(up%&'9%%9%%πU"%I-%[L8PE*T=Ea0(7%%)2%%%1%%%%%%%%%&%%E%%%%%%%%%rtzx%jfsr%Sgfx%uπU"p&'%9%9%%%%-%)^SxE?R95]&?'%%+,s%%%,%%%%%%%%%%%E%7%%Z(%%%rf%sSfsπU"%rup*%+%%%%%'%'(%>%%(%E+%%%%%πEND SUBπCLOSE:IF S=168AND B&=Z&THEN?" :) Ok!"ELSE?" :( Bad!πSUB U(A$):FOR A=1TO LEN(A$):C=ASC(MID$(A$,A))-37:IF C<0THEN C=91+C*32πIF K<4THEN K=C+243ELSE?#1,CHR$(C+(K MOD 3)*86);:K=K\3:B&=B&+1πS=(S+C)AND 255:NEXT:LOCATE,1:?STRING$(B&*50\Z&,219);:END SUBπJamshid Khoshrangi             LALEH'S MOUSE ROUTINES V2.0    [e-mail]             04-08-96 (19:03)       PB                     394  26098    LMR.BAS     ' Please run this code under PowerBASIC to extract LMR_200.ZIPπ' To extract under QB, add a DIM before SHAREDπDEFINT A-Z:SHARED K,S,B&,Z&:V1 'Created by PostIt! 7.2πSUB V1:OPEN "O",1,"LMR_200.ZIP",4^6:Z&=19247:?STRING$(50,177);πU"%up()%9%%%I-%Cg8WE\z7p+ANd%%A0%%%0%%%%qr(w.WU%USgfjxfLfYA\A$$YNπU"lEI$yC[e>IjFPds:I0_kEuIII#V1G8Ow\zB#Z5OAq-7\-i%Uu9rpfgGEhQxrV.5πU"1p83khnP%#g&IJQe.>>g9E^=ZCCCyuCCC(^oMb5e/L.vi[z.)r6Nw\sT^HGX3xjπU"f9xxw4YNv0lu9xo(YNwpNovXYv?DxW2cEKyvo38qHlxd&xolT[$iX^Yn,#tylk0πU"E&Xc]e_Vr_krbE/W7ml,#&VTOZs_7jj:8YExEMN0\aSNFm2m$*N3$GnkY8-eRt\πU"rH(m)XOQbFlX6RWoLUDrLK\rkX*b+G#/XsJj,bi,kH3-lVs/p#D)q\$]57IiQkLπU";bD506tgnVTB,q;6S9;r:<M;ht:roVW[mVq_^bn6a$ZdtqhY\;]07#cid)C'n+=πU"eWl],LcO_>K7]>jTtKH,)4(J96]_.U#DRV-$)M_sQA3FYZQT;5G+Wcr,BokCJJVπU"*,#22<*T338*B.M?(+0&xM+>1-F7qb,hq*m^dJQJN[b&YeomRt$iWgLp/%&\LmXπU"tp1<BHGKK\dGFN<(FIqMR,uBS#4UO<q*NjWi'Yb,+<NuG59HW(v<$r#=?<^>JV3πU"*opX[pq>Qt>bph)2m*>a(83rSaSY(XknqA/qr$q)EuGWlj2(V8Np/Vv&m\MdB3=πU"rIZ+dMnZm6:\ThFe?TUDVc=i6at??:%\VmDHV]1S((=dcrJ9.\$QlY>\pI-qACkπU"+.+Ut[t,ZS31Ff)(gQK,Xp^O,0wE;Z\u\<k>=QfGL9D'(T/DKiwo20prZEV]_J0πU"K8E181o#XhK0l*D<r^.%pukpiP+T(L\tPPn6N9jDVr)U_Ht(rxxMEDAqFFt\MsUπU"j4:6N]R8lkMU5%?3aLB]P2H_(]BEkI,j94bs:2[.yo5KL.TeD_>1k3LA)f1^zZnπU"=Bk&&$bJH(k&w=9joAF?Ea&8NZqtBGfO#DH7L\\f7eE8ZCE>bNF[e#?=?k6&hHHπU"#Pff,MpnKYbxV7\wlm&^lgTM'M5oMH4R:#C(LW90VMs^qElI(/H=KYA]6uVY_UYπU"nUEUt2H=RrP_W1nFck3px>Unr'>cdO^I_RG0Y+d__mVsZn)xr-p*$BiWHr'fXP8πU"'#ETO-)i[,hegt>Mhl++Q%]tt1;kRlvL<^>FkE^J:^:TI5Emp\DCs-giT5Yi>S$πU"lDMr,XX4fm-3>mpfhOJze:zPCs]m017^(e'gi59M#Fa/N1r8RoJ]J,RG/7eu[lrπU"X)K]t]9#,<6RiE]it'r,;6mF;BA?THE7NXli:%i5,CS\t**.wL>fJ?^IUk>R3m9πU"+\3i>h0uk;_]L?oSKLjG8AsVtIl;tG%hhmike#*fn5GFM#.0WMIJnsNdSpE.P1?πU"gOl(4]B)[+nA\iSM(ets\ouWs-tQ)tu-4gNVD>VQweuS'gtKc[/L.rrG+t91TpRπU"DBNVj8#GFR8I\AGb?gn=5oo7K]6IY5_GlqX>+es)7Kk$BCDHRq5*:CWXt#oEl6JπU"hJH=4>#=Q3VIP\Ua\H7,eGQIu.8A2wOm2&>b&kal(]mby$4SPG]qU-l5\?.rL?_πU"]^S.ABPL+lQ.vx?B7cZ6XY1f\QtWoz3-Y9\h.*FeYVZ%NU*SEU9\p\kqI<kVe?aπU"3.[D.nrk=o#ckDH:p'/h#eZA9lVH6J3<I%FV2$Y$BS#%gsRe&rr8mVF(5g4rAcrπU"V8(xG2HD'lS9&8d%Eumq7tcG/m\+M;&f5=1K$tNs,eu\cEL%:RxyE&.&TYM,HABπU"%p9Lg;e?#4>U[[t88iRc%noTk[:a[\r%?JJbcDM)1a/,*QROcHHBZGw/NadBJl]πU"v<oBABYw?HVL1&E&-1MHi,t+j)n00$g<\\jYPqf[[)iBMV)MDMlSGK\5HEjB_n'πU"brrLw9e'134d<1[c%]J%=h;,UgC3^18])9#I4=?RB_/YNd)PKn;Z>99aml-QPRjπU"gR12g:hf?tnaT+mFjaVaJ%/wlm:fJa[R%kG6BWt85rT\OFq(dtnv'd__\?/;a_lπU"[DQV2>ZqI;Ebja<$ZXogo*Irb7#_4L2G+S-0^AAEVU.*<\U])ooOFw0-(%Q0czgπU"&uhOPm4_u2^bo:,qC$C?3rJ2R/O3xg5Z)-2-bddMR]RPoeM-?Q/qv,6]a[AX?[/πU"R#Gh#pA$su\fsB7AO,6C^cp4XmNl>&Xa'J<.Eb9t04VN^X:vJU^Z#0,[4$M.>2CπU"aZ)Yr$&)b^(-?W;NHB7Y:J[S/J#Qr32h5:i,wpgAHfTMF5/dV.bJ[Q$\k:PG]_-πU"ORLKg6kaL[iTKl:<;8,[Cf*+1ONo'&pv+>TeH_,p>xn+Yjk4QTA;sRDR)&_:%MpπU"+at6oWYg<:zDY)bz7QK;fjaXJ^>IC:)UT;s10c%O\m&m>ku'6,R15e6'];6IbkHπU"iEb-DFlncv*KN0)cP[+&Y&]zfP-:M)2>2aN9=GxG.Q(O1d#;QTpA[SD,,,A+y>lπU"mb+2%C]yo/jdf\)WEDKKLr^eBMzHga\de-rUasHqRb]ca\C#reR\A6._(6<iSWzπU"8DcCp2OwWCkr[hkXEAQu*736#nI4g\t/,iZ5R3sqH0pV6<rUl*^P%>HV&85w3pmπU"08ufWKtRmow2UJ>'r>KG\]pqG3&T]cU,;&0+Mut3h.Md7+RM+eA58g9vUA]f\wlπU"DNsY>(/V9h;-Q)\D.H6J^AKCAbK&J4HuVj(;=[v3koSPc-o;;cf3y'mvr5oKA/kπU"=]>wEj%c<ALo[71P\RfdVIKy\yb3Z[Dl92';')^'Bp2fiP**-1DFa-R&;/sPI.PπU"FtY9v1c:hBmI^42xvP/L2QmGdeAqn1N0[>Ar26EF4;=G%JaF;ESbYpnBQ<#,Ez=πU"^$*irdK3nR=gE$-S5Tj[<K?:<4b$x]q06Y9V6v^N2BpRu$.>U5kePLRsV1crNWOπU"9PTWB3(ak[Xaj%W-u:HGG0]7CKYfHb5LtjlJ)-(p7%mu\#oNRY6KqwT$iUgL;55πU"&Wg_fL*529m(71$0#6iB;'u*%g&O5eg7?X4MCZ[\]YuS+erJT^Ye?-WHdb1V\\&πU"U/<(GeDy,lX_A.\xUE/qHm\EA:B6UG/fq>7-8w9$g7kT9W.%oT+K3#<tGFg.zb'πU"c%i>px4?6JSe&TSJJDTwN;1\Z04;=xa%R$\q2)I#OL9k8f&P\jKhc&koRjVIWs8πU"BGznvM/JnX^E/u;[hYMi(S^5+6=vL]rxC5X7?Webklr.Q$tfXxl?dgx<rQ'k+YJπU"1(bhL8kLI'<Zjjsc-_a8qe?(LHp.;ks;Ifa#*GyHf=\YUBuO;UkzeJr)ruN^Ag0πU"rhcUp5AVk]#F\N912+x#_;Gpu84bvNWqS[7F.(H;n[NJAN^Vp)tQE?LL2Ric'O#πU"G/yr<#>H2%4'&uh-WK\rq.\/)u)&)2GrpV06;h5(cSS\.*V-IsimU>[TJPq_U-OπU"C>$9.ctMUcbOms\ks,YAm92Yjt#/Vmpb&Tj6/W9AG^i;2Sp2A<Dj*4BR80*+u[eπU"loCTeRz,6\cqh#u$p<l?s(d9XQwM$#ph?J%ZfJ*1f6h/6FB:ddh9sFCF/oWI.VhπU"fX9mtv0XJiP1*P/mZheJ+)U(^Yn4(#TS>6aWGW\MU>D+xWK$BcnP=XJrJd$b58UπU"GBXJ0uTh_*bIK_QT\NCq\.B<>i/$]Y$aX'aj2;*FQ$j]fW<p6T_j/l^<*uL.x;dπU"rU0P';-IccE_(u>olC^wejVEqijc_HPsavMxN<WCy1Ewd2d5L]?L$6r0gne\hQWπU"I%9?RB'r>Q%'-rxc.TYBb-.r)#b-P&DiFl^XBX:HdhvR?^NT5)Ka:og0.+pX]I%πU"pUhP15R70D0LRR&C/2fm\%JvHG4Lxg+911JK3M[r#d.4nQ)9C%9L\YOHW97c>R;πU"+Q&rQT%;>f*4;OzcyR3xw6oJ&Ik/F-&9Jxgr%fsV[0dAq9ui1)AD4,A+ddL)+Q)πU"g^vC'VlV]FdcdbZ^+conkf=\aSfy^8G\iPt?fR(X&T]oQNgOy[yW30L_G\BhC]aπU":Js(x\]/7+PY.R?dM6d17FH0BRt?d5-oV_?Ho4\C89H[^q&ActP(cx$%MkX7hMEπU"xLrbk5RY];N/WeKSAk>y'4a02%F/g1M)nY8pVYNZ-(L9iI8Y,,jZspHjbiFm2=(πU":_K6pZoDW,tVN+/8WUJ=M,y'XWZw=?A;NUe.7Ks*a:g;5nvJ7V;tY9oU^%PKVy'πU"Bhto$ug)Gv;i$=i]EB:/yQB3Ah2.o-#9gC?QY14CBJF:(8(<)[<,DevJ'/'y7O(πU"ntay\j24,DktgYVX2R<0S#aLc$WAPY\3LYbwEDp*U6]xS#'CXt*dN*ts47g'=1PπU"YC2Zx.Jbjczb4:QO:7o;G/%-Adhp.i=fHUMkLE?dSiE&0k09<,fNpi+?L:aHim9πU"v+^7^A-G40$n5Aj;zAPJFlQV(tTV(zTKO0Q8?MoGQ_40/2a;PjGcJS6OXYXo[%KπU"OQMXxWE?[+G#._R<AyNBpNEj<MVw'hPjW08$;zzD2Zf?0ZDnL9#j,SLf+.0;s;5πU"YR[_O$XVvW-8:8[lfSD(?mP%JKtbqClJ3+;Lc_5z5uU'+#h$4C+<+'T6H0)b.S6πU"r5O6E0jj'U-E[?O],CbXjYeM>WLtUh%m(Fj&)VDM?-x6\\qu^>r/BzE2HyWlRTMπU"?k-+rlHZemIuJQBjV#Lt:puv##pYjYEj[v/5*:lgJ711LoUh_w,8TlSA3A%7([?πU"'-r$b[_d&U<oZ]&gU;OL&L%^DIxc^lsx+]VgiL7b<0h6NJotf/?wS,4ZY:K7/A?πU"fU,uvYomkK?4O+.aYWzqBA>tORv;A1do8qE(s]-we2p'J.dlSjIO*mzB4_oeE>oπU"rEkJ4[F%GAu>2l/#C3PgwW,Y:GcA=_&5emZPb/fUL:+?>t+B^LKP8JmDNVkC^*rπU"P(hklM1TW8OpjUDE=VdPg4tu1#1e;50U^HYGE**N/iu2N?Z<e6]%Gob(-+(CL'qπU"j5WHH3#QhGJg:Y[#O=AQz[2)AWCFuYdI^H,U#;?OXK?J*hh9$aC80;'fD'z*\&aπU"jY<_qa/Y[/,Zi]_Pcx6=KsA>?1M=;AEKfN]1i52sa?V(TvBJE2iu+K^CD'2)MabπU"#j^lbBH'J:IgW^)gJCdV:t/GpMgi+8X5VASLoM:t;GG:O)([EBL/N;XCfRR:b)hπU"C[AJ46-1<ucxmrR3B9*#l5p;qr=Wf#ckU5N.R^L8Yl)YEDaoIHZv#v)N2,0o11CπU"zbVl8y\xa$$jgc8o*D]/kzx+,Rd$o$;qI[#.2?VDsM/B^;V^m^iI<q&y0F02gUAπU"nAsp*$],ao_%)*C2metd#b4bcxt2>+,>chK-hrH$b[(C=y&G%C2bee#D3d]eπU"y5UHw*G44>HZQSi0\Wrq3ObCH5V%1M+uoeXESeVgH-[T_QEGPw9sLAXH8j./fnFπU"8frG,8gtGes?6J;tEa];'=G+CPi?A+Gc_/,97o0V05Y3V9ir*/(81qleuDyeaEgπU".ZT<pKqChuMLqdhiA^5jAuPqM1\*Lv7s/[%f)).u>_=-<qNVKUll5Ognn^j;R5GπU"<]Ztd_yza)0tVjY1=.?ME(YdfovnB/X#\O,LdqsFwp::=yP.i?<*:tI3M;7jz39πU"HTDQVZ:7zNT+j]F?2gA=^NHX*ZLSVxTq/9$],5$>vC,rz$lW$/ERYd*JO3cIT4IπU"ETc]MI9U$U?L1T:w0DO'Yh+F&;2=*F)YAU#z_ON;U%=$)m5O/HfboPHZ/<P+21TπU"CjD3m^xRF;'u8aiFJp\LnC/Fi6W-p>(=\a)G?i:sH[1Fi7)VqHU?SjQ+T:lF\L'πU"aELEJXt-=04r=4Cr1)=<hG/FrYf937s-_V4E0sE6%K?5L^W]$jl46;QE(Vm>MQ3πU"$8e-Z&9IEGdRMH5*qfvg\HY[===)JfuW]RZxaFw;VomA85Zpq,c,<ObVoj^ZFBFπU"TG$$nzurpHY/rF:1qs<+m]*INP7HiB(6nQ8RJyIsf*A4&O%s_LoRQ<b52^T$X(vπU"Cpy7^W9bjlKS)K#JNH-scb.mGVodTk(<jMs'(+hiQ>:]<=k[&e0<0(yf1vLxB^qπU"AfC>\cW'^#eUA(\umV$L_FA$hhrq;RMWG&TZ^w2MD&Q&eh#?1fHYK/\nV3*+YFuπU"UpIiH$?[aU)P##4MvJqa\w/=w]CN<,:GQh-9jR-+CGm3v2k604XtQiRYT\+rNC)πU"PakRu0owRLwB:VCtZdA(q:W5hFeKcm*B.p8<?,5fq_Vv0%cU&.&/QfM.bOTi9dCπU"<F82O.FiAi4#OX*;mp0i<\Pk732HZcZ..mBD\DQ$FDyc%a9aPv6#oB:MO*tk7u8πU";sR9IFBQGSsm5)t,2i9$z\phMabr6hqu(Z2j-2++YZE4f;2cpT;$k178SSVq,2bπU"%RqBOR#psz&lH<g<+otKJlS1pFVd2s#Igf<>\kPA2S'[zgreCN71^Wm,p.Mm,pZπU"uy;-oU5M?d&m\msN:GwaE]ilkTe-mVp5&2ol<Bj#pw,k7(vVfZ_D9q.gdVB)KThπU")Ei(sos_YJs_QGQ=vBpj:o-I%D3P%SZ>IZ/sedp.[QYQc3X;uA'qI$M&4,)YhmAπU"(q$daAY-)Eud9xbODB7:8/suRJZIs]_27(5X/c;4:#lZpf9d9G]T76Y(Qgl?pmjπU"1A($7?_4ln')\C&ms+21W#d>A^R[Uq+l\[GCgiSRyg^LG)B3P>iRo8Mh?V:9KcWπU"'N3m_L$tvxRdX'a^4cW-tIG:WAxURqT5eR&,3ZHl('[P>AGQ0bP+178j8:pWOu)πU"_<FFLK,B+Z4BQA0ab#/JFa#3ZOl46q%EBV(lPf\EI)(*V_aBssSp*KGp'\=iH:)πU":x^tDo-4s]f?Id(OlS(B^\G:UQjsFM%_xI(DIkU9NEiz]a>f1LlQzhO)'gK;itlπU";Kt)i*fe8Dpnw,Fn8B'*OKZj:R2_My+1-[76%I25)HB'H8)8]vsY-kY6q?Q5+ibπU"(k,+U:\[]m]kBA2?dy##jk>9$EheojHq=&Vo)wIRF(_\BHmb./LOWI_?10(:a<jπU"/W6V<$IaVAivejE9;JU5&B6Ou*B5Og\\_,j3d%IU#(tU\'4._Jm'q%?q:kGjhtDπU"wZ#;q7m4>sQsJ0H^upIx1wb^bLiX,PMI%U9Rh+P\4ufLPRP34nSJ'tbB//(e5n*πU"os7L.y/yP2oj&gUn67dDkWQM>vX5Yh3[hitR4cN\\PdEJS3UDZe]A:Ash#xOcncπU"xph:'e2wFF1<smE&+-PA2Vy+N'F5B&%nkD0?0)$3SL&;b]<GP.:0lU25RzXtPRpπU".6_h7d6b7h;'.f(JZ5<<sFR;*T:c6H;K*4Y^8^U0h1oKh8?LpRWfOnb&6MFsQi+πU"8Z9Rg.tfZfRyUHy?5)Z*hd1u$EwK]2pug=aBUv>.tu86=sxB36NIki7[-7JBTogπU"ly&P?GZup;lSCn]F(up;l?^j^pFFXDl(golPMZKd]th3hwkOKT<q9KyaXMJou:CπU"y4>Jld&V+K1NV[OofHwiHm/\pGdWOFOFo4J&62w&yn%cmE9\T,+UYkIWw]^bFi=πU"]6?&Ooeqsu%$klV2+=_0vRau(a#*Mkj#9xyO316&35n7ic2w[5127X+KC>2<QJJπU"hB<7HHq%WhZ3_S1/%SrO+:YfP'd/AJ:PvC[0=v%4J&e\'AR.ln/8B[AYP&Hf_*lπU"Fa7XJ8_U9E*Cj^E?Yut+_e8GS4OsE=9N$W\\X7T,8C/WY_Kss.Fd1tKqh_d/M#KπU"hUf4P?Zk/H6b/;KX$sG$RCeGX(G#o2z&&jWf3'/aQb-8+_Ujm+fVfZUJ7l9g?#sπU"W4/El)+m-#P)wE$P0g$RH8=zZ2(0H,PpIM;78/5RsvuoT>Ht-E1)vz9\63-<%?%πU"MolwAn9H]*VZBSA6=,;^&4.XvGuR4k=&wa>ra6]u+0[NqKV,g,4&77SzJwYHx2+πU"zOrpk*jj4(%Cz.y&HNV4vh)oV1ncGXObr1tVD\rbB*tJsgHbdX#$m_R18:NNgzfπU"%K0yB9<=Xea74.XR#WOg4>+p%CrE8PJxhkv:j$'P\_BN,^Pme=F?p,B#q^rEQ+KπU"*pBc,]+,kbu_73i0A.>AK=F5EE[B(g]p1/5$m.&_)iEG9nMUQ>V6m7.,,0<Fzo>πU"]ZkQDYc>-*Ao&b95_18f+]l\[xD7-a-\'K?a:GWI(P],l/=Ok(:V1sRDaq]Ffn;πU"$_,v%>Ch&ph/OHd0*ZV+Nn1]+U*6gkudw0jl,K%C><&q>'Kjsy+K-?MYq5631;(πU"fM_q3i6&Lhxgi&KA1$DSbNK]Re=qZ)9'GSu89\mJCNZo>^Lh8D3mVSwieHo1.^lπU";OCB;1UWEpc\fmXUvWIO\J<$Y6;(*misu[B#z&$\7JoQWO)<(s;uSS$_o.FR]P6πU"ZTUqU]TGIOuDgbN%0\Oa=3HJI/lh^jW84cHr,dQ\tPG)6kx6IAco[wx,]:sp,LeπU"\l?&iPO,iHO_\Bp/<;W2GPHkSJCYkNDRv?il&AH+r[j^6;.M<]^mTu?(e9h^sMoπU",It^*>bx406mkRWJq]la14.lk_<Kp_*#0vt$fb)YhI[>N[397x5MyRi#EANI9k/πU";T4k>2\j^+j*7SGR=nij=QE)ncKwcSwN1G#K2't%8vRlHj^br$wPBQwH?C*IRthπU"F2/m$_<-eSecapJ;Znecj6.DYAl<4YLYbd:t]]h$EH_ZKA'Ar3.CPz-qRo;:t$jπU"x*n\WZHrA\=/-CFS31w&HZjV5.^05v1h?MN]0lc_+\q)TlOgltCOWt3_)^)$9muπU"^+uU]jb,Qh/K$:o':.hBpu>\^U9h3_p8pX*\oWy4Lw/VItCYdcITF$CMf?VGdD8πU"i$7+L0:Y.[k<VGd-<bd)3;$-3(5d;YWn.o$8$>5mBgt<JCH11$uMBrP#F#XcjunπU"lx/PZObE+4XT)i2Vm,.lMAdD<5d\S5d&5=dF?2O:%q4$j0:>o5gaI$OYQ/\OAu6πU"ZQ?mBFeM1WZSjIn8rix=fSxXB.c-JFbJdICI_RJ0YI$=3;mw655L4>9?%ofIVN:πU"v?qV[O):b$Gptn5v\_*ZrkbC0QV#RlBr5;$BOHwd5.>58x<GfJ>n=hC-^51'D(SπU"lm'n;bR,ns>OM&:zxe2e(s8O;uPuQ$oN;tnN4*hiuyxV,1Xz)[,[f7^r4dubU6aπU".%0rm.LzJEyL)b,P&RoJ$PNJ(yMce#x:/sTfe5z-6'r6x$j)3%.CLM4Df/N-Um?πU"Sg-dKeCwR3f\)ACl*\q^U5TLNVKDGA;[jIm7Yx1tg.'Gnd%#4n-#.rE&V\4BoN]πU"m<4<l1:%4M=U&DQKk9Y9OWYQx_hxMPuDRC#NZAiqrCI?$'5)GC7%BdX1x##TlLsπU"2.C3--i9&ysWNwP&QqK;)P2bpKCH?5s3ksbC86x&mv?BY=bCTmEwVHYmkqmkAe=πU"?2^G(aluDc+e5WkvTQ6SM2*_[^eg8$P>tM6XC$RC/vfC5L,XHR_XbIT/;2IqS%IπU"lYOlh_.1bATo\-)/h4veeD$Y+d/fRQRR[Kvc-qfnRAnh)L$Ytj*:p#I6EwTMkS6πU"aauFJmqfYN^]FOjkiZU?/C%^Mvuw?4KZWBQPag5I&FltfAPx1^m/&TD_W;J(DRyπU"8>/9b#741pMJ5\u_-1v*)J52r)2)Olca%k#^CF&.FEw+FK:FM2%6Yq\2g[*z\HXπU"T'b][dlgV%$+j,BW./>'#]?cI&A#J4Y24:qY9Z[;AI]1RwAkL9W&$Eh5aR3S>tlπU"LH+,S9TQ4qB8lTF+3\E>7:W$Y*2)Fo'N=i3p5-b&#Dq+;/.vn%c*,MlC'RqRsikπU"THQ=#(Yem\;egqpE<4cDrN%v3/#zEjjIsYY=nd?%2<c4G9uxE$T.gLnn,s[g<LfπU"dC(WACv)#vfMA/c0i])cIf._x\r)62id%/5aoBWbKe9t-n-Gqu2&T1p=eB[)IZVπU"aYi4eB.zik$;n_YuX/9Pqzlx9ssfSbZ-<d))VI&u=/x_PS6^HeUI9ktQ*O,qHj/πU"IftX+CA?]iDf.v]Ks%S]#0(/vp+Kbt82]vt?3=;J0j?C*o.BF7:.G6<ip4vqaQIπU"eSrC%yfdD.s'O?kcxHr'+_vmVZS'vOV0e<Wl6VxY]WbDVSTRLQ^Ct3e67M#ha.MπU"Jqa65AaGwM(1-kxa36%$vZtQCvPfmuiZDP(oP?[%iTl-NDG488996oEJGC(<qR\πU"/Wi*pSn,6T2qGrgtL+sBW23[;v7nls.CFD(-^;;a=2T;\nK<4znSje*S:F^zcm%πU"S[T^yCP3fQ4r?fag(XIH$jD&V&/m2QPV<bsI_cen-:r8SIZf.e*lG.,+L=*W./uπU"g4N-3>Kd5KA2LhKkibt^,d*5$6yskt98?vb70e6n33DLE;RE6V[J6fk2-YESthCπU"lRw8pUt7QgBfo3Pjhn(i?&8sC..lWq)T.6*A('z+6lUHJQ5aV0kRK1nxiTUY[PhπU"I=QJ1nY\36K^c^t'WQ$Svjh='3]Z>O32dduDY?RR&QmKW0V\Cb4Nv].xK;^*V%vπU"G71D).BFS'7'H-uubJN*.z=k,xhI5kY:vUqz.i]unB5*&Ca&=TBBe_^Aevt+bwxπU"ofop<8nw2c;g+EcimK(;8MdrOu^$7W50\g4_SFLYr>M[l=?=L(dDfe37wRNDIEIπU"QhddA.gSe6;\MR6-fiB_daCjma?P5gAaKcpD'OYra1Cj_wjC?SWIsy0[b2m5AV*πU":+1%5fauU0l_z/IGBuuFSmQk)]I;L)sgMW.ya$-5(EZ'GiZR;*m_e>B0UNkcOK2πU"uutnJAN4gLLpy\nC#MC.O=T5j0FzoMH=%^;Ypgo(LhOI#Z)z]<>Xt_gMnDhc>9YπU"kn#M;ZU=qDJc>Vtv3,<k;&arP%83b(nGq,os*tbKJY8:\]r2QnuqskxX*#\OxbYπU"pK;eq6'W#_mvB:mKXc?Dgf(,8$&FBGb-a,R\0AZ%ZGt<[*A:T-MIf-FfM#.W-MFπU"De63#riVDqG3nVb^<AtRDELiE9Y;%,WY7y7(^pzy+u*;WJgPp:j6c=*Bk?Y<7WVπU"zp+x_e+&$,\K9T2+-SvQU%P.L[=zJa4n+-_i3:M>hg*p,^7:8H/DL.)VNqzbjTgπU"42]a,5S'DeHf<#L>t1+whNQ-H?6&H'Pb524lk7gM.^KQ^N>Mk]V-CK)pJEkX3+XπU"Eqx\d4E+Z,>s%2%[SW>?<0]]A_3oAf]y'nw0RZa^'OC$/6[X_IM%n_>yoCp2Q9SπU"iLYXQQ8)&>ZX2pd(e,t+s)GSVQCT;/3,Ege28;5jKKde2[0mo(XzK-QaFM?w0$UπU"*--[GOo/\aHr$LhKK%_P=9A'ag?\GF\bmgdO8jm\'Mjp&a-aI%+;:(tw?.juzU&πU"/[959/,0l(*%Qm<QY##3]I*aeU7#6tO7A574D<Mak7gR+LQa)0f=.PV)-1y5]#iπU"PGn/VdnaSMOCwEO-*IS*RBCl3l7C<dPrAGuZ<#xbp+voct0&,x\l1f\tNWoJ#sXπU"g<,*#UWw-iRjARc]d]DZUDM<L]QwWl46AKe0.rS1Z\OY3Z4f_7VXti$[l)k>I&tπU"]%q&<b-aO?ABH]rM=Ji8RxLjCID7Rv)wghM;&c+^Gk=_Qd(mK.:4XmI$_I>%e/fπU"l)/I\rxp$0(pmFqPN=s,>&>SN4BOeQjlqS,B;>$;(i1=vlU,60(-kJ4b)8O<)RZπU"aHf>:XdwO<1<5,'0^6Ar9<hoBRygh;D5xXOmuEn=zuBI'O6AeH[tb&F6c%sFj'oπU"9$hDYcoV3Y9QhoaFTT25H3\Z*1H*fp'H6T&S>lg7Q%'50J\5Qe4NxpDEp$S+6NgπU"WM]'^dj?KL&j(EdE-4_J,2PNZ6_uSVoYI]0hMTrd=1]X.H;Ge_bQBK_]3=?CcV?πU"+t_S,Aqk*iGq/#F[$1nnG\^[]bH?[J*5O1r-<?K[bhb69GaF=g#%J5CBQmkx'puπU"=4&&7&;<=-'sRM-9=bZXiel67Ofo5Oi>c0$z.7hy(,Q0r=*62nz)FOD&agll.].πU"jQO02?OaWKJkl)/RO\\_&XLG?P6sp[6<Gsg+hP6BcPrTCP+z%6+L).hmA%;>D-IπU"tnT:?cO#29x>\oP%rA14)'qOz:JM\Y+KDT)pK>x?vGzY0Ckt*kc\Z'_YJ_%YCZBπU"^E/e<?jRf<M9)5VU+r$,1RolOXQQ4Q8SUhySSLtXN4doW3vRpr>MfmtK7s^K^KLπU"\XkcGjVk#[C5I+&cN;D/F=.tf8l=h_b.n/8aI8RCO/nDa+700i5L.siUrL3<H[,πU"OJ)lZ#1_z*#[f[py$:Hp[kD;_SEJrp;_PiedwXJbqXHr>2e+LP/*s(D?J7_'RNUπU"w#jgTKGTsZe7ABQ*;s'0(yfHfVv:7mH8nZ.xo[QTL(Wo)CxkxKLy(oaYs,rC=$7πU"eGs+9$q^ERut9rF+<r3^2&XwJ/L[W_I4F2?cHX[<>rlT,SJGm1B,pww)1g]WKuSπU"2afs7:M.$o$-in<<P6]Ylz912zA\[0*7gu%17_k**GXKrSUkDO56/r/b\8QdQ9DπU"?QqsE8qCPtIB5C$1KT;box]laMP;7AT$j.yG&a#;#MnKgt.]v:D$<.u-CexzWo_πU"L--H]#V^)kv<L2Qyd;qCxQi5Zqx+aE;B/d5tWs-0qOM00%\1ofqDKm5p,e?<1_,πU"pbTAaSf&Mfa^*;9+SqWaoi-$^zWeK7tp2GS?CvXJzX[j\q3Su6J&EiRvIUmd:?xπU")RMJ/k:y]7PpaU2a?5U?Ra,FU0'eh[=&-XIpUoKSU_nnzeTmPiwW,.dx0-B%-+RπU"W3,3WsJb:>_dzpdP1OTRG?*g,PFXXp7XG0B\u\=yP%9F.)O6[;^?AVtFD*r4rg_πEND SUBπSUB V2πU"R383S>r4Hz<#Os\0ELQ$GnO>%[a5OgYBq&ft4ZlJ*j-ZC3k<D=d:dR_I+:zy$<WπU"4J?)%GGDQYDUC_(BX<5%5YGUEQ&0ae/2h8h2\aYP''gp#RK[8MSpVkVRKpjR2c#πU">Vi&&2-AeA3qHvE,yJVHNkU*T(ODd6+H,:0Uqv8bN_2A[fE/%7c.=wWWVXNiq\bπU"ZCP=u_?#FCR+^x88]F<q=Vg[DZWZgImPbSJ14SFLYnhqRF&G[A>-;[5jBsORQprπU")QO?/u1f1<==B1-:[T6o8LjYSF3MMXX\8f7$C5%:]?o;YA^0\HU8d'k[l,a^-W[πU"8khwAcU)=3qz_/44cAr$2hMxwi6$UT7ma_Ya(%$M+l3l;fp]d#d#dgq<VzBQegsπU")-:kylN6eoBL5J,,_hrhS$%Yj.hce-iff^_z3KTeayg$43C98#9c7Oh,.;[S44JπU"J:=UG67M*q'uu'RIK>TDs=t\aZEvTlr[y$j4eSCeLI#(Ir7bh0T.c$EnbhkbtfSπU":(M8U#T9zJ3??4sMcp?FToOO*O%W>?3VKrpZbG2qneKTfeP.B64IkbFZ;gL6zN/πU"0hw7i6I=?vmbm7n8T)%2d$Fd,+sS7o'Rto\H>143Hd0i+^_/RUMjQa-3xg2zW3FπU"eyQjHm+iV:1J#Ky-w&kAXDpmOPd8ykkiRY$t+NvCM\v/s9Y1HCDrH*UXqi.F3d\πU"61'DvxrgE[2%'r/v-2NGZt$fsZFSZ#h$4LoJ.$eV2X[#.m;1sOR/r>+Gj8JTMFWπU",bMp'5o$iusMIKgt22Q0d9]IJI'HeKtuELH9\GS*V8ev'Vu%-A*%=LV>E\^u8s>πU"x%*up(%)9%%#%-%XDcWEF8Q(Iw[-%%Q%B%%/%%%%q.rw.W%UUSgOnF((&^#\7_MπU"e&xX,;i5f?0J[52,O(C)US:\cm?2346;d:>c3Y*cgr[=moEM%dO0Ilt7MienmMFπU"Z+Ag%A._7GAR:1'DyZz.^:ZjGl<j:kumw6tZpAJnfXdjH:fTXdux#u,).NbMHudπU"Tn>Mt^8uSvuhH<;iWcudfZstxstrHnV$'0xBdTSDcS1W'nM.W:x'*[XylRA92HGπU"M/Dr90WK?g](;ASjY[k#)#+a/KtfD,dY$yotGRAraI&B$,fTx5X3BO.:IQjlC)LπU"*-K0yg,(T<VM_tW2EYiQgOU_z5\m$<9(u4GIWN$Y^s.^ZOI+28q%FIPN51kp#9WπU"u7Y+d4ofE5/#Ra&8sb1ZKGq\[HM2d%K=HAAda'eP)rlORRz])mC>XnwqGAoT2NsπU"sVj^R8=94nd'a[gCm^aH#gC):?Aki_'^p1i4bAL=^u\F?m.(\Yi04W'%eOHp=qCπU"I1bHo2r'7$HTQ8BT5s<:)I]1yK6a<,4<YF\Y;?W4-v7cAG+u\Pqf5>LZp_NG;5SπU"n4HI)fM,d<XD7_tNs%CrlVW1m$N1HYzUj;,MZ**0pjd$ipn>f<wrC$4D7l1j(\(πU"09xhP#&3g[9$]bAwLAp/bQ9vJlF6aV^p-)fs,spc=$372VW8\mA<fRO6E8%2ENRπU"/bJ.:nlwBO<gUUJ=#gFXUC4%Q66\,:(iz<pkC5,:R(*63_cxTg?x>;onC#S7QdwπU"jr.%3Db&gm+0fLg#\6mb[im2Z[z9gF.tD2YEMx-p6>'axAycsr9^lQYK1xIVuqMπU":B91HYERN#AjmO_<RDO/OZPcSaFkH5Nh&sX<OH;E7/kO4-RlKfG[BO*cms*<JIiπU"dkCUG-2&x/rJ4I0B9l,tL:S^'Pgkd+.'#?Mb-,0%'Pr;YxO?j(iQw567C)ge,;8πU"/4J.Y4MO8I4IAJDt7VL*j_&dIHkTu8(4I[Cs.J;'2nuNvJf%x3+_2q=AEA/i1NsπU"r_WAeOGmLkKf?Z=d;'iJgt+MCU7%9diTIVq?HqJom(GGe?02G)%W[r+W#W8js>*πU"mhEUCD5Hf+Q$9jWaM;Q_DX0gkXWTuXZY(k5Yf0_):BgM=^G0>P<Z80&bXqoAKQ?πU"AO63&D:Yxckl=c^];\W'8oX?AKYu6;O)nc%Ug_v<u1fLQl=DU$zwNMBCr:AJX0:πU"mQ=AAOs%FN3%eP(qPiP0\Ppi1#M5Y0Dxky9jaX;05PoLA)anq:$/=CSfsfyi'EdπU"h\zBorrRwWZ]x:rPCYXL=I:.rj'AExmH8(SaGXo*znXG#gTroa4$L*^4rP*^IJ=πU"&[:P^h9aMHg:pSXWuYQity?X.C&G<*f)yuWNC=D_r]\-,sEwrU%=XU\Y3u')9QxπU"qoF&oWb,4LUL-,.=<0OX%A23c,c/QN)Rr1LBKKdI#xS?;.y2t77m$M+F0_Lp&V)πU"wwgAWC:*9o/5O76eoiOQT251#8*hemzfTO_Fio^H042v$)'22cRm#zV1\c2gx?$πU"i[H^+3=ZmJhKig0Q>X2d$#mYX+17wW.qG't$DZN&?;5R_8aiu(_>gLql=a?]>zcπU"KQ2/a^LB7wLnuf^Z&l+C?Kfk*iI3+L$2A,8C)xc]Kp#mB%q0aLj(/NbO/qZghP*πU"8^Y8W2S]Iu*FG6qPEzLcoNLh-CKe(c(Vv4$I/0XA&gi]CH(FL_)yUo1RP:VoMq1πU"X7'JjY_=og..HdUK3FpB]r9(<0NKQ?5W3yA9OxkB9W?AX6l8AL;5Hg=V[vRsq<CπU"ulB'\AcW#_r48>Wg$/YB^Lc\R4]r:3cZi=;6k-:)dVt9=8eI^^Nr4Y=2Ca>MD.mπU"o1,SlRD-&>EjfIHbe,:>_On1E&E*FPAr:#64D3[[[kFebaiZNJx?P('m(g2jPf]πU"oQKc^$M2Vn%teft?8VK.T$Q$fEYTkJV2ilrQ$E#7<O6-WqCbQ&3sXT%NER5-lZcπU"c2/IEY4La;Zrn)_>CUAo/3J9$k<dEa/826d/DUM*HnZY=3TEElmmHQakO50i):?πU"W#B$W,s],p$L50Gi?5dS/=X>Ui'3Iq,%)ZqPdr#\O[W-GGR#^<N'4hepDSRbEXQπU"LmeGr=4Rh]348jUpHm#3,l>u5%8cU<6Z'ZRd:SGgQRU&skOMU=([kx8uuW3;;Q,πU"OjY]6f?Zx]Jt<K#b9:#iFt'O0jj)0*7H]\qD.e9.3P<\Ke3-%Z/&V62fm4[j:TRπU"E7T#<]LBAYRW>]G'#7Ai9;ns4bg,1]L0,BI/]QUT>#=ytZ-$'X,U$sYpH6>w5:tπU"^5tNT:HBfhL<mg'u,EkmI)=;D=4hS=El#UCB<i%2\MKB,dv6lC8tB=D'-0d;?*rπU"_ey\?1T.U*2Y.s73V3U,4Uq)mSI2oW?A7p[VI>l=$SoKKieO(&O1*Up)reuaG7JπU"(4,Kr7kQ4E3kVrbx>Yl^HupY6tdq7tX'7H+41Qm.3J[*1]&'u(u;E4w#U;w(E<mπU"$vcufn5DwbVq]trbAR'eEi,fU=X0F]SoD06pYe[]WgTg09jZaYgPKykr8=NqqWiπU"W)7rRMV9]TLXNqZUJmbC(YLt[DYs;a7O*PdYhBGF_rj%r[RjbheqG3dT7d:]\23πU"J(HAvrLE8[-gjpWN'-am^dem:Zi?c,Jv3>r3g6394NfDy+huiq+kxD8xc_6\d?$πU"?(u04o5q0)M,4H>HcGbC[tM<,]G..O&$GPFp2I=7N2;.%Ae]-BC%K;(t;e\di5FπU"Hx*WN&u%p()9%%%%-I%I,hCD$\N-S9(%+%*,%%%0%%%%hts%xyfs%ySgnSdzD=BπU"T]9,RLewPCxom6^VPD*nd)I;6HMOBL>eREG5#m&d[6YMHiZyNM.-Ya5lR\\PeGLπU"nSBnV-Gt+)1.Z9e8-qPw(&i9w6%osyV.UZ$*)xcaMG)cd=W'>'>7.FtH:+(C.efπU",e2&NNedYprdMup313PYB.Llp+k%Xxxoa$eX\r19&BM/g%an3g94we7hTJqF7s/πU",vhEmKG93U$Psu++ITN>ZWn+*Kf/#[Ra'(KPr,3luegwmMtvk5Zh=x1]KHt]3d)πU"Mq$2T+bO,](P:POAEOE,iYr?6aKC]/,HCmBD+a[m%;1uV[58hOrFoSw\Y?l\A1JπU"GIA88m:&n6dkOS?XRZ=WSXB2MZSE+PN6OS/EAQARG7s#TAEqSAMAWCuAX92ou-.πU"scp:LmN\_$6MVX]luwQrE-%KwJ=jJj:S_uvbV%oMt8%txx&zT0D^db^amTf(-SEπU"8u9#1Rx-AaB=zK=45]<Ki$IMLlaGVWU=iDsgxvjhpZh_,u:$M?oK81j5g9jXCHeπU"ADoso&eRZFk/U4S[eNzVm>u.Mc7bq*3CGVBd:,W6LyB*#Aev(mL4U41Q(QklhgEπU">L]sDu+lB]TTKP:;gUSxB]S<.(e^tl?>T=F&7Z_p:Z3O/JN]PwAS=-Mgjog;bd)πU"5#^kHxJXtJ<.PxkUBGY$4Q8DG/Ho?NN)=$Yy?)s_ejXb5r/zRK&el:I1G6'+WY^πU"7_(Ci?8rC+S[1MfrVTQjwh^vR_sp?Z>;e>I>.+cdh)t(oP?k/?-iH+WQoAA3[,rπU"t5VKZ/7-#L:Yv8CYc+J+JnY)rQ<6)Z.q#M\UVu/zB3w*^:5,)B;GCW6QsLn8^x-πU"CILd/P4Fe99,]0$1C+u_J^=^Vp<bLkFa#=8MFq=w5wJw$shMFj4OaXW+sX]C9QVπU"/$>b^M;^*wXnZjqJtESQOhN?djRP/w5Whr-g<u*4<J'T?vd.=[_XAIKP]++A:ukπU"2NvcS#YmJFJU-b7qn&V.?n[u&^RZlNH?eP0Oc.AiZYqZc8Kk\ul/LeN6,E+uJwLπU"P$o;egdkRtIWWOT?'/I:CQ-?ANj>+R_3M86=.b^tskc,KT;Kx)fS[=4+g8t76cKπU"'&<W+E&JRv<Kkc2hy]:AkZ&(2hQP6$wU0S8ZqWu#_\pSyBZ>FZRRmo8Z0Q/AbHsπU"22NLsPMsRXutu,4<E5w6<#itLBxjn&GMt5+VDFKCcTWgl:9nulG2ZDLrnjdX%upπU"()%9%%%R-%RgeWEAU&Nu$6.%%PT%%%0%%%%ts/.j'n%ySgfjxF)VtBT/+bNHqw2πU"V\vB'TxjLCsJ_8]Gr$+RiLc$%JBnsPitaP7mm=ZCnw%8sjrdh*gQDEnt]f<kl2IπU")dR7'elpwEZch?\iQ[bbvFtY#ncRmxir#GN8mCQZZqyNna\m4k^Q2E/L,Ox9O3DπU"/Dm;sPXjhG>Doc.&h6R$=.\tB1s^hfnmxTkXfn:02^s=LC;w>>k6U?+Sxcn'Q#,πU"UN+n.'9gKwA'.H$?DPw<NP$p143?ilX;ne=9[?c<:/pN0e^BNQ9806(k'<1^'πU"#uTR;k'B]EDsF^]VL+D<Cj2cO+j#WwFm#?ZiA+2b&n&;IqiCG25(+)3UmB?m.0rπU"%aAA9%l;b8Wq?b,'?G[Ugs6U(/<?=:>NJj=DYLo0u>x9'OmS;&xjbETVTcZOmtnπU"9tp?DZ83U72I;Ug]&/WC+<L4I7\?:HH_p]IeMTT+)i]k^SM:B^NlcecCEH<h0\6πU"yOEa&e&pYuASG.(,,e>PcHPKcbMS.$f;vP5Op=G7=_p)ra(R6<La21=8F_3,9lmπU"WQ7KdDs6jan*a\[0?Mhj#;??$6GGBme33jk&lNWLh)SNVfpTL2pdee=?KAn&0/kπU"3I:^n;c&Vkh.nIEOu9DmpRWBtj[T+f?J0qXZ7YK4?2DJwi0tI%<-]AzGkneC/A5πU"oC0T2B^[vBAJc\qTXUOh'oYi[.^B+C7hh^S;fuT;GiC:/N8Hhu=l#.cEpw3'^$HπU"h+>Jx3_=usHb$nih*rHUB)\>?grAzC;)sWuFLO2bO0>DpQ\4MWOVR[s<\&7^f:jπU"E&]1]ZVGMB9[c3F\)<j^w\o%rurkd5RjcPJut\VFM/d1[>c+K;gq$+vuridH2hGπU"/lRyz88O,A$OX3hR$V\<pc-dBh)Zic1m<cDN9w'Z3s=K$7;4Azl]E/J-i>;[?c,πU"-ICmD':d'<HuleAi*IqvlxWUbhPsq%%Nj]8*E_6l-vC5ziAeMF**1cyG=7i8.kUπU"BbL[On>pMFE,UHNoSeP;_H$5)I:i/Ap6[ea;O7bLnMT%Lk\<4pK\AjV_'I:VAs;πU"3T7km5=(klS:vpC89-ZtJKk&Jd1Iw]Tn.ee>C&YQ&a.rVcBRmPBZCZ;BYK2O7#oπU"aoo#nvFtIqJ^w$jtKR,1&N#g.WsF#r67BZD4dU(u0n$kB6f_,I)A4BHRQ4jcDQHπU"2CGep)bX)[dj;aB-Ciae;=C*sqsfGo&39wH;4h,vGLU>XpE/q<p4O=KaCc/w,v)πU"^>hR1)%GDZ*rf[<_bTvXq&sPl%QBeq1t-=<xwSnS/#mDdY*0F.$qTi/=RpuX9>GπU"-G9c5C%Bo%W]]*+kkfKeILln]=34RI>J+-pdo^a[YPb(e3V16)Vc;u<A]JUAN;9πU"S$GO^laqrWLD_9HNdhcZVs3b9Q'LB<fU&:.tAR8OSgzm9rUYL'_Klfa7COe;QcTπU"^dwN1,I+>#.?ZuhImObhI94iUEeu7m/Ayf'iq7+mKO$.V$r[$71M2=wjc5'q..1πU"D\3SAYhg-pG9/vwZTGCN+wV:v<^k+m+drg2e/Tb]Er)wEVw&:%Ibu_X-i7;7K.?πU"N,^OYZDR6k_wK1K^Amv-]8A$qI##qp_+E0kU3QBCq1.Z^4C0pEGDdqf<U(/f+uJπU"(1D_jLfVaR?4^IIRy1FtY+Yf:&E*ou-N4qs%C7'[m.O:S:n2LE0rxd[<7SOoDGdπU"I='*8<nVcuPrOwePP%Sbc.mo,KY9FkX:MI'v%^GfvB;iwDrRPQ1%gExPhbVeRk1πU"6v+ZAJsy[/>m>PP=t.dym_Za_7m,g$h#6:I7c65AN0HRCY4H]>xI&WS5AOLoFXsπU"$=^1#e[)zUG0t2pU0]xBTdU]-Sj-=%qo)jL]B8G#h4J)_Mr<s[[kiPu(s0pNuntπU"T:jDv/32)[RJ$NkwaSU9#D:$B3o&in>FGtYf5J3gI3i]%(K6$NZ<M/C$z*%tvs4πU"o,8u:ObQN[QoqQWu3o<Mdo*<hs5RqdGvq[#eryy:mLK=;yr*1-hB5<'%P9g_6-'πU"M$'g?B.NPcK#lZGBJ7,R6se*LRk4xwe4vo%>tT4$\IW9S&OZ>+DnI*,SH5g>5byπU"efXUp]7%F>Sx9nDj3'nlIhW&DeyxZ?$=jN^9ET59Dt8]M;cSP6isZmIg\V+p$Q'πU"hUZ0x,a37yi)pajLaJ=YEfeg<,\c5)VOTF*b#0XkYPZAAAE#yPW$QJAq)W1<>0mπU"?V.qc3I#J#w+UhwUYJ>^QBFg/)4%*J2D+k-6k/R7&WA[X:Y^)u?nBXO.rD]J_XGπU"\%BauL96<TKl>3P(%fAltT>i:+U,vT)1W-3Yrxmu^^J;VH=cT?lN[P(0RQ_H*IbπU"lGW.q)0:on*_z;m/nNhgxNOoA,^1+yuEn9+IKn.,C%eMJ7&cmuvNfwTSHD?HI09πU"Zta;?#=FkLG,lM2kbA$?v=kpWc8k*n&DDi87z$&7nUB32'8C:tD'g]$W.fGP,3\πU"4X1ok/\f4m7RvRo6r6rR+ygwX\4XpjRfoU8XS'G*_#Z$9$D%RP]gIAKP\DZU4(UπU"HH>2QS>(>#[90uA$W,o[C&SYqv(-A]%>BSIO\M-#bPL[$nxLP3.4tS-?uOM#Lu?πU"pY3+TP,[2q9Ct#C8_PgrG%:kH1NT*m>5Mu4^q_:Ra2JjX_VL0n:dk5E=SwV4AowπU"l:g*J&%*xF-t2=:bh8:g-k<a#\.Dj4OYwsFv+t7D*iPF>ZD\j^$t6FDM?*?,Xr$πU"iiUTtydQ-xU2u[eK\7I&lwauo4Ze/Ecm)n?#UGR;DDVE:1V*Z9ne=g_)q2IALb4πU"-Yf?*o)1W;8(Xk]Tdu5jM]&?%L>JMLe&TgX$:z<(_M=0qEVG_koUFR,WZ;3+g2uπU"zwlnq[WV[QZ3o)-Y_e=_s*%xxUT9'd7DUq/m0f/=,;n/.\b(OG#QcU'#up+R$x#πU"2LdshiXskse^%U01I*u-d-6jDa&?+_Lk,qIQqS0;c=b*#di#SclU1Aqqz<'g1btπU"U5AX[1UV:w$CD)sXkvTA*UOZe;f,FsKiVJI,hEZz6&cv(?VMLl//]+YOK't]TnaπU"+>LB+mbDBOY+/=>3Nf*$IIlckb8C2*seoP>DF7'/6a-2rS:BTJQ\*1=Lk3Y=#<eπU"foS=#-LW:#l*UE%t*S4Ka$C/FsWH]7nJ8DgN$H:E5V8,8=lSYApG<gSSNT$nRL.πU"0klAoP$%ukjI5zCP&M'TF8eH^9*mwWm^.9O?dA\*R0KNO9U_b4b6M'_>mSDl<6uπU"WTO;u##;fe<26,'%Q>1F8S-pk&nv'1;cHQ<KhmYuJ9M3IFMVZ'NmSPGa\7-fZ/*πU"%0(SJZ7M]jzt5J^^q.rm+u6.t.YsMOiPC/%D]L#Z,L#9Jniri:OYZ+P]ew2<&QjπU".ZzB&o0m,)Ou=:23]+NxEB*SIfY*D>/rVk)H<17/mP,Er=g-7SSCuP'Zxts\(X5πU"YSg$kf#Uk:diB6M3:#DFY(V*]$42E[fLveYAIM/i?b[guJv$iv]^ORlPi1'.;q\πU"GMb3G_3M-H/e[f-zYW3P9>7Kj.Cm_?xA5lNRYh/2Ui71*%#$AeFT[V%LQRn5EpBπU"7n.uFHXUz-OA[O?KmYGT9rUw%.o7\')J2V<'o83jaJ9a/G-5DHD%)GQ$FQ9#[xzπU"1Nr(UTX#\MldxRH(u6h^B/LMAqN<)U,SdxNmOfiYq2uR&$TW#BbZwd([c^w>II:πU".(KLT0jWPwmrwqU6qji/-r?;j>G%#Tv?icRYcog7m6D9+*TpucW1&;Z:._j9C#xπU"QS,m^AEpF.&Mpm?3ccFh<fpG.;PvNm=G=6_kd?eFQbOwl&C(n\$dRG,2Cx$A)]xπU"uqmx?^BA>Cp427_KDm>y:xPt/-MCj*2EI_T:NR00[vd2+Luf]J(1-q]m$XUNm.6πU"V#4XNOI+Fn5U84Mm[VCEGAZ')\VUmn[9JZOBHr:HA_,9AV46U2Af*D>a1tdU,AmπU"uR?GM&IEise)Y>UGIgZHhPHd0EcNZICr_L8%_lJ.2JhK&[[9$GmPyS=J*)^z=gxπU"c=.#S,.=+=]Vyt4:3'+kA1I8iJYn*UBIq&\jZKuY_XD#4Y4p;5[?/FaUQ>X#UnTπU";jWs(Lv_U=G?d]7sM2R%^#,M4Op=PW->;mC>cSImT3rNUeV?=wZ$[Yd%LuNc((pπU"jU\gqc;MuoZxk\)H('3K$elCPP^/ku5aYwpctbjK6_Wa$O7D[tXFN&B=z1F0^fYπU"hL,FJRjDp#Fz;#+8kbHi4h:+n9#oCMH&jt=,bZ[e]$mpbp'.%ljNDX<N^.91j--πU"&6I>&ZMSc=y4l/<M\$9#3&nSZz=Lej2LZf.X:)'60_uD.$4k1mM03pqIVp(1n#*πU"<&peR;=7bIv2M?ef_p;0V+a/OZ.R2MKHvdd#e$>-/kTeYw>xEw5U(4+EN#LwcXaπU"4Er1orRPsAZPYnO/S_(z=aNpWPu0L=qsDvoW63\SF_Dz%NAE]4K%Y:NPnE5Br1jπU"'?^8g)LtZjmXu:#h3'\Og0Tn<g904u7F4xpN4bl-qAn9TDtqB];/5p3Cw+\_H5VπU"gTk(kJ:&5X'N4)*UHqvZ?(gkbz8ppAi3<4Oh]H+9RFv/YFU9.fqC#R7V?txGN7-πU"el:[LI]h_tT0LSJ:BfD-JXBlL)ife-o)z5=dt>5j\7H$C3?QT:J*_$BzWX*gweYπU"wzO$]30j8'(dg;k/(vM%IdPAJC\o'bzB*>)V/lT1C_rai[Fvnr^r,]+HBG'gKH\πU"+dSJG^Q0DF6'69eLj5Km7gG7Ak)f3NbwlqA<v6G2U44WCK-qnjKR'cJW\U.z_hvπU"LX7Tb3<olEqpGT3iR\&tTZJE[QfZxuRjdr+N%Oe.'G9MHc(kk.y(WNmO?2g2pBIπU"yD3Bu#f3K)962*$WGiajJ28n\a6/F>M4r3%SSN(o6D%cg^&t-4PK%$fI_rmheoyπU"oZsOS9jmW,dcuV0qV5mW,e)_I,qed$u3w7<l-(EjU(.UP=(3e&Jr$]ZbrbZo,aoπU"bxg_19D$B4Cpt\hpFP0e_sCesvjksgt=)luf[M:t)8kN&nmOI$+^A8BBEa>(VDKπU"f_G]2Db&wJjnLkAVjRts4)u(MXyZBS)O*2rQwD5mL7L:oZWCnC*r30x8u6w<FJdπU"SHfT\*'W.BxMVCQMxWtQg/,zt^CXL6?VNKo(GIQsw3DZvDk2g6ns;bpH>OFLyqZπU":R8y<9=*x[\ClxMWGcbY)Ns$6u]NMreE2rspRcJ$ETi7>$4u4Q$*,MA1qw6c.g0πU"-2ZFw0i?2'm?1$xBD2n3Xu(3916/4Z/V]$87NUrr*5t7=jU^p16dzBGshS'w36MπU"LPs.6XE\f<9<VTxzsE%b#3K.8=+T;6b4zHI:--C6))zZ4>-yd&J<7#:NLFulJkUπU"uw\vnq7U8Z9%)QJmE_\=B_rfNreN'c6#0oxfNz^,%7b6mZh'cdMZuAN.PcJH$p%πU"N[Q^D+gYkkuSJ0B+cnSTDpFZwN0>.lS.0ufmllmX]M;-?'wX^54J(#keYWSw&q?πU"7RFM-p;_75#*d:['FZJ_Eg:2s8)ZkT.8$sc=%c(g/daxC/d5sU5MLP]:zRokc*iπU".YENpZI:lYuVddwdTP+qWMt8zyDdNz_H8H>GHUY+^<J2Woe_liYkEd*$U^%TvuvπU"xI=XNGw]aCua\?>jx'%up()%9%%%7-%r$AYExv&XO?'7%%w)%%%1%%%%rt%zxjiπU"%jrSg.fx\w<J=SU(9L37*x?:FI2KYOP<V7vInr?U/&\0n>746y_(#l-:5r=1W*^πU"SsYEh\PVn785B/hE,_*g:BO\$mJ5KeJPiQQ52RyS:NQ(4t'R$0gekN=v;Vjl]juπU"d>fnFgcSNBhK(2kH1b5uqnu$:W*0zjc'<8%O.G_;Ie;.Dju9+4[^0qXxqW=h;LrπU",jI]k?*i43DDv0AR1d^7'UDQD>gNZn%OYR3m)S.lAq)lG7-%g,n%oLQ/=xiQ:AnπU"*.dNNi)v(Yhh?\]L6NqUCE[&cL&4J(1f;Im#a'CfE<*dWOf3?A;/41lJnz;U/t=πU">C#7el$Q>mV\P'/h;j3I1job8WpqV;7[1%7]\Ey?qToU5AP&7Q_yIfFgI-M&f7PπU"^jtK*6(^yTi,X3&P>_9V^:;CW\gBdzB-,59NkP6YrBmD)6WbxfzpY*nOZ3SYmn_πU":y,WOa^C[3\_6n:*iLID4X\1l,uW'Abl?#'EHDf;*gQa,J_v,QJK(]LBOMgBbZ)πU")ANe[(u-gM:SiOI1XdP;q7^A3YB[fv'7&Wnu67#aDhzQQ5p'3cJmh-6[A/q^6f*πU"a3<Q9OymX=Yp_Q6B7zb1#+6&/'64mbg+%8JI40oRYv\]=zh4rNW4FUmpY87HjKbπU"jH=#s4U)Lqs%T#amx*W7p(,HLI+gL7N$NTP$bTh3:?8i+8U1x'%up&'%9%9%%%%πU"-%2CgWE'\zp+'AN%%,A0%%%0%%%%%%%%%&%E%%%%%%%%%qr(w.WU%USgf%xup&%πU"'9%9%%%%-L%XcW1EFQ('Iw-%+%QB%%%/%%%%%%%%%&%E[%%%j%N%%q.rw.W%UUSπU"g%nup&%'9%9%%%%-I%I,hCD$\N-S9(%+%*,%%%0%%%%%%%%%&%E#%%%:%W%%h%tπU"sxy%fsyS%gnup%&'9%%9%%%R-%RgeWEAU&Nu$6.%%PT%%%0%%%%%%%%%&%%E%%%πU"%y[%%.ts.j&'nyS%gfxu%p&'9%%9%%[%-%r($YEx)vXO?['%%w%)%%1%%%%%%%%πU"%&%%E%%+%1l%%%rtz%xjij%rSgf%xup*%+%%%%%*%*%%B&%+%un%%%%%πEND SUBπV2πCLOSE:IF S=154AND B&=Z&THEN?" :) Ok!"ELSE?" :( Bad!πSUB U(A$):FOR A=1TO LEN(A$):C=ASC(MID$(A$,A))-37:IF C<0THEN C=91+C*32πIF K<4THEN K=C+243ELSE?#1,CHR$(C+(K MOD 3)*86);:K=K\3:B&=B&+1πS=(S+C)AND 255:NEXT:LOCATE,1:?STRING$(B&*50\Z&,219);:END SUBπThe ABC Programmer             PB MOUSE TIC-TAC-TOE DEMO      Advanced Assembly Language     04-08-96 (12:00)       PB                     218  7414     PBMOUSE.BAS '===================================================π' PB Mouse Demo Programmed by William Yu (04-08-96)π' All? Interrupt 33h Mouse Routines implemented.π' Please use and distribute freely.π' Interrupt 33h routines courtesy of the ADVANCEDπ' ASSEMBLY LANGUAGE book by Peter Norton.π'π' NOTE: Mouse routines are NOT harmful even if theπ'       user does not have a mouse driver installed.π'       So you don't need mouse checking routinesπ'       scattered all over your code.π'       ie.  MouseInstalled = MouseExist%π'            If MouseInstalled Thenπ'               MouseShowπ'               blah blah blahπ'            End Ifπ'π' DRAG 'N DROPπ'   Use MouseInfo (Drag = Button > 0)π'                 (Drop = Button = 0)π'   Or use MouseQueue and MouseReleaseπ' HOLD BUTTON ACTIVATEDπ'   MouseInfo continually reads mouse button infoπ' HOLD BUTTON DE-ACTIVATEDπ'   MouseQueue - how many times was the mouseπ'        button pressed since last poll?π'π' Although everything can revolve around the oneπ' routine MouseInfo, there are times when youπ' cannot poll the mouse information every second.π' Use MouseQueue as a substitute.π'===================================================πDEFINT A-Z: CLSππ%FLAGS = 0π%AX = 1π%BX = 2π%CX = 3π%DX = 4π%SI = 5π%DI = 6π%BP = 7π%DS = 8π%ES = 9ππ%False = 0π%True = NOT %Falseππ%LeftButton         = 1π%RightButton        = 2π%LeftRightButtons   = 3π%CenterButton       = 4π%LeftCenterButtons  = 5π%RightCenterButtons = 6π%AllThreeButtons    = 7ππSHARED Char, Char2           ' Or you can add extra params to CheckBox ()ππIF NOT MouseExist% THEN Print "Mouse required for this demo.": ENDππPlayTICTACTOE             ' ESC or Right mouse button to quit demo.ππFUNCTION MouseExist%      ' Call this first to initialize the mouseπ   Reg %AX, 0π   CALL Interrupt &h33π   MouseExist%=Reg(%AX)   ' NON-Zero value means mouse driver loadedπ   '----------------------' An alternative route with inline assemblyπ   '! Mov Ax, 0           'π   '! Int &h33            ' Interrupt 33h Service 0π   '! Cmp Ax, 0           ' Compare Carry Flag Set AXπ   '! Jne Init            ' If not equal to 0 then mouse driver existsπ   'MouseExist% = %False  ' Else driver not foundπ   'EXIT FUNCTION         'π   'Init:                 'π   'MouseExist% = %True   'π   '----------------------'πEND FUNCTIONππSUB MouseShow            ' Displays Mouse Cursorπ   ! Mov Ax, 1           ' Interrupt 33h Service 1π   ! Int &h33πEND SUBππSUB MouseHide            ' Hide Mouse Cursorπ   ! Mov Ax, 2           ' Interrupt 33h Service 2π   ! Int &h33πEND SUBππSUB MouseInfo (Button%, Column%, Row%)   ' Gets Mouse Position and Button Statusπ   Reg %AX, 3π   CALL Interrupt &h33π   Button% = Reg(%BX)         ' 1 = Left, 2 = Right, 3 = Both, 4 = Centerπ   Column% = Reg(%CX)/8 + 1   ' Remember that it returns in pixelsπ   Row% = Reg(%DX)/8 + 1πEND SUBππSUB MouseCursor (MColumn%, MRow%)π   Reg %AX, 4π   Reg %CX, MColumn% * 8 - 1π   Reg %DX, MRow% * 8 - 1π   CALL Interrupt &h33πEND SUBππSUB MouseQueue (ButtonInfo%, ButtonPress%, ButtonCol%, ButtonRow%)π   Reg %AX, 5                ' Returns ButtonPress%/Col%/Row% valuesπ   Reg %BX, ButtonInfo%      ' 0 = Left Button, 1 = Right Button, 3 = Center?π   CALL Interrupt &h33π   ButtonPress% = Reg(%BX)   ' # Times button was pressed since last inquiryπ   ButtonCol% = Reg(%CX)/8+1 ' Current mouse cursor columnπ   ButtonRow% = Reg(%DX)/8+1 ' Current mouse cursor rowπEND SUBππSUB MouseRelease (ButtonInfo%, ButtonPress%, ButtonCol%, ButtonRow%)π   Reg %AX, 6                ' Returns ButtonPress%/Col%/Row% valuesπ   Reg %BX, ButtonInfo%      ' 0 = Left Button, 1 = Right Button, 3 = Center?π   CALL Interrupt &h33π   ButtonPress% = Reg(%BX)   ' # Times button was released since last inquiryπ   ButtonCol% = Reg(%CX)     ' Current mouse cursor columnπ   ButtonRow% = Reg(%DX)     ' Current mouse cursor rowπEND SUBππSUB MouseLimits (LeftCol%, RightCol%, TopRow%, BottomRow%)π   Reg %AX, 7                   ' Horizontal Limitsπ   Reg %CX, RightCol% * 8 - 1π   Reg %DX, LeftCol% * 8 - 1π   CALL Interrupt &h33π   Reg %AX, 8                   ' Vertical Limitsπ   Reg %CX, TopRow% * 8 - 1π   Reg %DX, BottomRow% * 8 - 1π   CALL Interrupt &h33πEND SUBππSUB MouseShape (ScrMaskChar%, ScrMaskAttr%, CurMaskChar$, CurMaskAttr%)π   Reg %BX, 0       ' 0 = Set Software Cursor  1 = Set Hardware Cursorπ   Reg %CX, (ScrMaskAttr% * 256) + ScrMaskChar%π   Reg %DX, (CurMaskAttr% * 256) + ASC(CurMaskChar$)π   Reg %AX, 10π   CALL Interrupt &h33πEND SUBππSUB CheckBox (Occupied(), Y%, X%, YCor%, XCor%)π   If NOT Occupied(Y%,X%) Then     ' Box is emptyπ     Locate YCor%, XCor%: Color 15: Print Chr$(Char)π     Occupied(Y%,X%) = %True       ' Make Box occupiedπ   Else                            ' Box is occupiedπ     Swap Char, Char2              ' Return to normal cursor stateπ   End IfπEND SUBππSUB PlayTICTACTOE               ' Not exactly, but it's just a DEMOπ   DIM Occupied(3,3)            ' Make sure we don't overlap movesπ   DIM Grid$(0 to 6)π   π   Grid$(0) = "+---+---+---+"   ' TIC-TAC-TOE Gridπ   Grid$(1) = "|   |   |   |"   ' Only for demonstration purposesπ   Grid$(2) = "+---+---+---+"   ' Not a functional gameπ   Grid$(3) = "|   |   |   |"   ' That would require some additional workπ   Grid$(4) = "+---+---+---+"π   Grid$(5) = "|   |   |   |"π   Grid$(6) = "+---+---+---+"π   Char  = ASC("X")             ' Put into variables for easy swappingπ   Char2 = ASC("O")             ' Change characters if desiredπ   π   MouseShape 0,0,Chr$(Char),14 ' X goes firstπ   XCor% = 10                   ' You can modify these values to move theπ   YCor% = 6                    ' playing grid around.π   MouseLimits XCor%,XCor%+12,YCor%,YCor%+6   ' Restricts the mouse to playing gridπ   MouseCursor XCor%, YCor%π   π   For Y = 0 to 6               ' Draw Playing Gridπ     Locate Y+YCor%, XCor%: Print Grid$(Y)π   Next Yπ   π   MouseShowπ   π   DOπ      MouseInfo MouseButton%, MouseCol%, MouseRow% ' Updates mouse informationπ      MouseQueue 0, Button%, Column%, Row%         ' Does not allow for button holdπ      Locate 1,1: Color 7: Print MouseButton%,MouseCol%,MouseRow%π      π    If Button% Thenπ      InGrid% = %Falseπ      SELECT CASE Row%π         Case YCor% + 1π           InGrid% = %Trueπ           Grid = 1π         Case YCor% + 3π           InGrid = %Trueπ           Grid = 2         π         Case YCor% + 5π           InGrid = %Trueπ           Grid = 3         π         Case Elseπ           Swap Char, Char2π      END SELECTπ   π   If InGrid Thenπ     SELECT CASE Column%π         Case XCor%+1 to XCor%+3π           CheckBox Occupied(), Grid, 1, Row%, XCor%+2π         Case XCor%+5 to XCor%+7π           CheckBox Occupied(), Grid, 2, Row%, XCor%+6π         Case XCor%+9 to XCor%+11π           CheckBox Occupied(), Grid, 3, Row%, XCor%+10π         Case Elseπ           Swap Char, Char2π     END SELECTπ   End Ifπ   π    Swap Char, Char2               ' X -> O and vice versaπ    MouseShape 0,0,Chr$(Char),14   ' Update mouse cursorπ    End ifπ   π  LOOP Until Inkey$<>"" OR MouseButton% = %RightButtonππ  MouseLimits 1,80,1,25      ' Restore normal limitsπ  MouseShape 0,0,Chr$(8),7   ' Restore normal mouse cursor???πEND SUBπMike Wegner                    HAND MOUSE POINTER BITMAP      QBTIPS_?.DOC                   07-04-92 (13:21)       TEXT                   18   897      HANDMOUS.BAS'>Sounds great but how do you use this bitmap for you mouse cursor.π'>I havnt done anything with graphics yet but will be soon.  Howπ'>would I use a bitmap as my mouse cursor?  Thanks for any info.π'π'Here's the bitmap.  It needs to be read into an array of 32 integers.π'Then you use interrupt &h33, setting the ax register to 9, the bxπ'register to 4 and the cx register to 0.  Then set the es register to theπ'VARSEG of your array and set the dx register to the VARPTR of yourπ'array.  Then hit the interrupt and your mouse cursor is loaded.  Prestoπ'- 1 pointing finger.  Gee, I think mom said something about that once,π'but I can't remember ...  :)ππHandPointing:πDATA &he1ff,&he1ff,&he1ff,&he1ff,&he1ffπDATA &he000,&he000,&he000,0,0,0,0,0,0,0,0πDATA &h0000,&h0c00,&h0c00,&h0c00,&h0c00,&h0c00πDATA &h0db6,&h0db6,&h0db6,&h6ffe,&h6ffe,&h6ffeπDATA &h7ffe,&h7ffe,&h7ffe,&h0000πGreg Shultz/Dave Navarro, Jr.  NOVELL NETWARE ROUTINES        comp.lang.basic.misc           04-06-96 (00:00)       PB32                   231  7052     NETWARE.BAS 'Novell Netware programming seeems to be a more and more important issue these π'days with many programmers.  Users are demanding direct network support in π'many applications.ππ'As a result, Greg Schultz and I are working on a public domain Novell Netware π'library for PowerBASIC.  Most of the work is being done on CompuServe in the π'PowerBASIC forum.  However, I'll try to post updates here whenever possible.ππ'Greg has Netware set up and running at his office and home and I am in the π'process of setting up Netware at home (we use LANtastic at work).ππ'If you have any code you would like to contribute, please email it to me and π'I'll make sure to review it.ππ'I hope you find the following code useful:ππ'We've tested this code on Netware 3.11, 3.12 and 4.01.ππ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''π'   Novell Netware routines for PowerBASIC 3.2 or laterπ'   Donated to the Public Domainπ'   Last Revision:  April 6, 1996π'π'   Contributions by:  Greg Shultz          [e-mail]π'                      Dave Navarro, Jr.    [e-mail]π'π'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''π$CPU 8086          'make compatible with XT systemsπ$LIB ALL OFF       'turn off all PowerBASIC librariesπ$ERROR ALL OFF     'turn off all PowerBASIC error checkingπ$OPTIMIZE SIZE     'optimize for smaller codeπ$COMPILE UNIT      'compile to a UNIT (.PBU)π$DIM ALL           'force all variables and arrays to be declaredπππ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' PROC:    NovellAPIπ' AUTHOR:  Dave Navarro, Jr.π' DECLARE: FUNCTION NovellAPI(BYVAL integer, ANY, ANY) AS INTEGERπ' DESC:    Make a call to the Novell API.  Return's true (-1) if call wasπ'          successful.π' EXAMP:   Success = NovellAPI(Service%, RequestType, ReplyType)π'πFUNCTION NovellAPI(BYVAL service AS INTEGER, ANY, ANY) AS INTEGERππ  !     push    DS                      ;ππ  !     lds     SI, [BP+8]              ; point DS:SI to request packetπ  !     les     DI, [BP+12]             ; point ES:DI to reply packetπ  !     mov     AH, Byte Ptr Service    ; put service in AHπ  !     xor     AL, AL                  ; clear ALπ  !     int     &H21                    ; call API through DOSππ  !     xor     BX, BX                  ; clear BXπ  !     mov     AH, BH                  ; clear AHπ  !     or      AL, AL                  ; we're we successful?π  !     jnz     Done                    ; yes, exitπ  !     dec     BX                      ; make it -1πDone:π  !     mov     AX, BX                  ; put return code in AXππ  !     pop     DS                      ;ππEND FUNCTIONπππ'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' PROC:    NovCVIπ' AUTHOR:  Dave Navarro, Jr.π' DECLARE: FUNCTION NovCVI(BYVAL string) AS INTEGERπ' DESC:    Converts a Novell style integer into an IEEE integer.π' EXAMP:   User = NovCVI( User.Object )π'πFUNCTION NovCVI(BYVAL x AS STRING) AS INTEGERππ  DIM y AS LOCAL INTEGERππ  y = CVI(x)ππ  ! mov  AX, yπ  ! xchg AL, AHπ  ! mov  y, AXππ  FUNCTION = yππEND FUNCTIONπππ'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' PROC:    NovCVLπ' AUTHOR:  Dave Navarro, Jr.π' DECLARE: FUNCTION NovCVL(BYVAL string) AS LONGπ' DESC:    Converts a Novell style long into an IEEE long.π' EXAMP:   User = NovCVL( User.Object )π'πFUNCTION NovCVL(BYVAL x AS STRING) AS LONGππ  DIM y AS LOCAL LONGππ  y = CVL(x)ππ  ! mov  AX, y[0]π  ! mov  BX, y[2]π  ! mov  y[0], BXπ  ! mov  y[2], AXππ  FUNCTION = yππEND FUNCTIONπππ'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' PROC:    NovMKIπ' AUTHOR:  Dave Navarro, Jr.π' DECLARE: FUNCTION NovMKI(BYVAL integer) AS STRINGπ' DESC:    Converts an IEEE style integer into a Novell integer.π' EXAMP:   User.Object = NovMKI(255)π'πFUNCTION NovMKI(BYVAL x AS INTEGER) AS STRINGππ  ! mov  AX, xπ  ! xchg AL, AHπ  ! mov  x, AXππ  FUNCTION = MKI$(x)ππEND FUNCTIONπππ'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' PROC:    NovMKLπ' AUTHOR:  Dave Navarro, Jr.π' DECLARE: FUNCTION NovMKL(BYVAL long) AS STRINGπ' DESC:    Converts an IEEE style long into a Novell long.π' EXAMP:   User.Object = NovMKL(255)π'πFUNCTION NovMKL(BYVAL x AS LONG) AS STRINGππ  ! mov  AX, x[0]π  ! mov  BX, x[2]π  ! mov  x[0], BXπ  ! mov  x[2], AXππ  FUNCTION = MKL$(x)ππEND FUNCTIONπππ'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' PROC:    NovConnectionπ' AUTHOR:  Greg Shultzπ' DECLARE: FUNCTION NovConnection() AS INTEGERπ' DESC:    Return the connection number for the current workstation.  Ifπ'          zero is returned, the workstation is not logged into a server.π' EXAMP:   PRINT "Current connection number:"; NovConnectionπ'πFUNCTION NovConnection () AS INTEGERππ  ! mov  AX, &HDC00              ; get connection idπ  ! int  &H21                    ; through DOSπ  ! xor  AH, AH                  ; clear AHπ  ! mov  FUNCTION, AX            ; return resultππEND FUNCTIONπππ'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' PROC:    NovOpenBinderyπ' AUTHOR:  Greg Shultzπ' DECLARE: FUNCTION NovOpenBinery() AS INTEGERπ' DESC:    Returns true (-1) if the bindery was successfully opened.π'πTYPE OpenBinderyRequestπ  Length  AS WORD   '0001π  Service AS BYTE   'subfunc 45hπEND TYPEππTYPE OpenBinderyReplyπ  Empty   AS WORD   'nothing is returnedπEND TYPEππFUNCTION NovOpenBindery () AS INTEGERππ  DIM Request AS OpenBinderyRequestπ  DIM Reply   AS OpenBinderyReplyππ  Request.Length  = 1π  Request.Service = &H45π  Reply.Empty     = 0ππ  FUNCTION = NovellAPI(&HE3, Request, Reply)ππEND FUNCTIONπππ'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' PROC:    NovCloseBinderyπ' AUTHOR:  Greg Shultzπ' DECLARE: FUNCTION NovCloseBinery() AS INTEGERπ' DESC:    Returns true (-1) if the bindery was successfully closed.π'πTYPE CloseBinderyRequestπ  Length  AS WORD   '0001π  Service AS BYTE   'subfunc 44hπEND TYPEππTYPE CloseBinderyReplyπ  Empty   AS WORD   'nothing is returnedπEND TYPEππFUNCTION NovCloseBindery () AS INTEGERππ  DIM Request AS CloseBinderyRequestπ  DIM Reply   AS CloseBinderyReplyππ  Request.Length  = 1π  Request.Service = &H44π  Reply.Empty     = 0ππ  FUNCTION = NovellAPI(&H3E, Request, Reply)ππEND FUNCTIONπππ'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' PROC:    NovLogOutAllπ' AUTHOR:  Dave Navarro, Jr.π' DECLARE: FUNCTION NovLogOutAll() AS INTEGERπ' DESC:    Logs the current workstation out of all attached servers.  Returnsπ'          true (-1) if successful.π' EXAMP:   CALL NovLogOutAllπ'πFUNCTION NovLogOutAll () AS INTEGERππ  ! mov  AX, &HD700π  ! int  &H21π  ! xor  AH, AHπ  ! mov  FUNCTION, AXππEND FUNCTIONπDave Navarro, Jr.              RETURNS DESQVIEW VERSION       comp.lang.basic.misc           04-16-96 (06:58)       PB32                   40   1511     DESQVER.BAS '> π'> I search a method for detect DesqView and others populars multitask if present.ππ' DesqviewVer routine for PowerBASIC 3.2 or laterπ' Donated to the Public Domain by Dave Navarro, Jr.π'π' DESCRIPTION:π'   Return the version of DesqView installed.π'π' EXAMPLE"π'   DECLARE FUNCTION DesqviewVer() AS INTEGERπ'   IF ISTRUE(DesqviewVer) THENπ'     PRINT "DesqView version";DesqviewVer/100;" installed"π'   END IFππFUNCTION DesqviewVer () AS INTEGERππ  ! push    DS                      ; save DSππ  ! mov     AX, &H1022              ; DesqView API Callπ  ! xor     BX, BX                  ; clear BXπ  ! int     &H15                    ; through int 15π  ! or      BX, BX                  ; is DesqView installed?π  ! jne     NoDesq                  ; no, exitπ  ! mov     AX, BX                  ; put version into AXπ  ! push    AX                      ; save minor version number for laterπ  ! mov     CL, 100                 ; prepare to muliply AL * 100π  ! mul     CL                      ; AX = AL * CLπ  ! pop     BX                      ; retrieve minor versionπ  ! mov     BL, BH                  ; mov minor version to BLπ  ! xor     BH, BH                  ; zero out BHπ  ! add     AX, BX                  ; add major and minor partsπ  ! jmp     short Done              ;πNoDesq:π  ! xor     AX, AX                  ; clear EXπDone:π  ! mov     FUNCTION, AX            ; return version numberπ  ! pop     DS                      ; restore DSππEND FUNCTIONπDave Navarro, Jr.              ANSI VIEWER                    comp.lang.basic.misc           03-19-96 (23:10)       PB                     215  5113     ANSIVIEW.BAS'> Could anyone please EMail me a complete source code to view ANSIs? I'veπ'> attempted to code a function myslef but I have been unsuccessful. Thanks!π'> Please replyππ'Converted to PowerBASIC by Dave Navarro, Jr.π'This is a copyrighted file by Tom Hanlin which is included in theπ'shareware version of BASWIZ.ππDEFINT A - ZππFore = 7πBack = 0πSt$ = CHR$( 27 ) + "[2J"ππAnsiPrintChars St$ππOPEN "I", 1, "CHESS.ANS"π  WHILE NOT EOF( 1 )π    LINE INPUT#1, St$π    St$ = St$ + CHR$( 13, 10 )π    AnsiPrintChars St$π  WENDπCLOSE 1πππSUB AnsiPrintChars( BYVAL St$ )π  FOR disp = 1 TO LEN( St$ )π    ch$ = MID$( St$, disp, 1 )π    AnsiPrint ch$π  NEXTπEND SUBππSUB AnsiPrint( BYVAL Ch$ )ππ  STATIC ANSIst$, ANSIcode, Row, Col, SaveRow, SaveCol, Fore, Backπ  STATIC Firstπ  SHARED Musicππ  IF First = 0 THENπ    Fore = 7π    Back = 0π    First = -1π  END IFππ  IF ANSIcode THENπ    IF LEFT$( ANSIst$, 2 ) = "[M" THENπ      IF ASC( ch$ ) = 14 THENπ        IF Music THEN PLAY "MB" + MID$( ANSIst$, 4 )π        ANSIst$ = ""π        ANSIcode = 0π      ELSEπ        ANSIst$ = ANSIst$ + ch$π      END IFπ    ELSEIF INSTR( "ABCDEFGHIJKLMNOPQRSTUVWXYZ", UCASE$( ch$ )) THENπ      SELECT CASE ch$π        CASE "A": GOSUB CursorUpπ        CASE "B": GOSUB CursorDownπ        CASE "C": GOSUB CursorRightπ        CASE "D": GOSUB CursorLeftπ        CASE "H", "f": GOSUB CursorLocateπ        CASE "s": GOSUB SaveCursorPosnπ        CASE "u": GOSUB RestCursorPosnπ        CASE "J": GOSUB BigEraseπ        CASE "K": GOSUB SmallEraseπ        CASE "h", "l": REM set display mode... ignoredπ        CASE "m": GOSUB SetColorsπ        CASE ELSEπ          PRINT ANSIst$;π          ANSIcode = 0π          ANSIst$ = ""π      END SELECTπ      ANSIst$ = ""π      ANSIcode = 0π    ELSEIF ASC( ch$ ) < = 32 OR LEN( ANSIst$ ) > 60 THENπ      PRINT ANSIst$;π      ANSIcode = 0π      ANSIst$ = ""π    ELSEπ      ANSIst$ = ANSIst$ + ch$π    END IFπ  ELSEIF ASC( ch$ ) = 27 THENπ    ANSIcode = -1π    ANSIst$ = ""π  ELSEIF ASC( ch$ ) = 13 THENπ    LOCATE CSRLIN, 1π  ELSEIF ASC( ch$ ) = 10 THENπ    Tmp = POS( 0 )π    PRINTπ    LOCATE, Tmpπ  ELSEπ    PRINT ch$;π  END IFπ  EXIT SUBππCursorUp:π  Tmp = VAL( MID$( ANSIst$, 2 ))π  IF Tmp < 1 THEN Tmp = 1π  LOCATE Row, Colπ  Row = Row - Tmpπ  IF Row < 1 THEN Row = 1π  LOCATE Row, Colπ  RETURNππCursorDown:π  Tmp = VAL( MID$( ANSIst$, 2 ))π  IF Tmp < 1 THEN Tmp = 1π  Row = CSRLINπ  Col = POS( 0 )π  Row = Row + Tmpπ  IF Row > 23 THEN Row = 23π  LOCATE Row, Colπ  RETURNππCursorLeft:π  Tmp = VAL( MID$( ANSIst$, 2 ))π  IF Tmp < 1 THEN Tmp = 1π  Row = CSRLINπ  Col = POS( 0 )π  Col = Col - Tmpπ  IF Col < 1 THEN Col = 1π  LOCATE Row, Colπ  RETURNππCursorRight:π  Tmp = VAL( MID$( ANSIst$, 2 ))π  IF Tmp < 1 THEN Tmp = 1π  Row = CSRLINπ  Col = POS( 0 )π  Col = Col + Tmpπ  IF Col > 80 THEN Col = 80π  LOCATE Row, Colπ  RETURNππCursorLocate:π  Row = VAL( MID$( ANSIst$, 2 ))π  Tmp = INSTR( ANSIst$, ";" )π  IF Tmp THENπ    Col = VAL( MID$( ANSIst$, Tmp + 1 ))π  ELSEπ    Col = 1π  END IFπ  IF Row < 1 THENπ    Row = 1π  ELSEIF Row > 25 THENπ    Row = 25π  END IFπ  IF Col < 1 THENπ    Col = 1π  ELSEIF Col > 80 THENπ    Col = 80π  END IFπ  LOCATE Row, Colπ  RETURNππSaveCursorPosn:π  SaveRow = CSRLINπ  SaveCol = POS( 0 )π  RETURNππRestCursorPosn:π  IF SaveRow > 0 THENπ    LOCATE SaveRow, SaveColπ  END IFπ  RETURNππBigErase:π  CLSπ  LOCATE 1, 1π  RETURNππSmallErase:π  LOCATE Row, Colπ  PRINT SPACE$( 80 - Col );π  LOCATE Row, Colπ  RETURNππSetColors:π  ANSIst$ = MID$( ANSIst$, 2 )π  DO WHILE LEN( ANSIst$ )π    Tmp = VAL( ANSIst$ )π    SELECT CASE Tmpπ      CASE 0: Fore = 7: Back = 0 'reset colorsπ      CASE 1: Fore = ( Fore OR 8 ) 'high intensityπ      CASE 2: Fore = ( Fore AND &H17 ) 'normal intensityπ      CASE 5: Fore = ( Fore OR 16 ) 'blinkπ      CASE 7: Fore = 0: Back = 7 'reverse videoπ      CASE 8: Fore = 0: Back = 0 'invisibleπ      CASE 30: Fore = ( Fore AND &H18 ) 'black foregroundπ      CASE 31: Fore = ( Fore AND &H18 ) OR 4 'red foregroundπ      CASE 32: Fore = ( Fore AND &H18 ) OR 2 'green foregroundπ      CASE 33: Fore = ( Fore AND &H18 ) OR 6 'yellow foregroundπ      CASE 34: Fore = ( Fore AND &H18 ) OR 1 'blue foregroundπ      CASE 35: Fore = ( Fore AND &H18 ) OR 5 'magenta foregroundπ      CASE 36: Fore = ( Fore AND &H18 ) OR 3 'cyan foregroundπ      CASE 37: Fore = ( Fore OR 7 ) 'white foregroundπ      CASE 40: Back = 0 'black backgroundπ      CASE 41: Back = 4 'red backgroundπ      CASE 42: Back = 2 'green backgroundπ      CASE 44: Back = 6 'yellow backgroundπ      CASE 44: Back = 1 'blue backgroundπ      CASE 45: Back = 5 'magenta backgroundπ      CASE 46: Back = 3 'cyan backgroundπ      CASE 47: Back = 7 'white backgroundπ      CASE ELSE 'ignore anything weirdπ    END SELECTπ    Tmp = INSTR( ANSIst$, ";" )π    IF Tmp THENπ      ANSIst$ = MID$( ANSIst$, Tmp + 1 )π    ELSEπ      ANSIst$ = ""π    END IFπ  LOOPπ  COLOR Fore, Backπ  RETURNπEND SUBπJames Goldbloom                PERCENTAGE BAR ROUTINE         FidoNet QUIK_BAS Echo          03-08-96 (00:00)       PB                     138  6502     BAR.BAS     'I wrote this originally for Power Basic, but I've decided to link up to thisπ'echo and share some PB code which could easily be adapted to QB, andπ'is useful for some...ππ'I decided to share one of my routines with you nifty people, so I formattedπ'it for this echo area and included help and tips, etc.  It's a completeπ'program which demonstrates a fully graphical percentbar for use in anyπ'of your programs which do lots of loops and activities requiring aπ'percentage of completion, etc.  It works forwards or backwards, canπ'be told to use numerical values in the display or not, and can alsoπ'be used to display instant percentbars without needing to loop at all!π'This routine works decently, and can be called within your loops toπ'show progress bars during copies, disk reads, alphabetizing, etc.,π'in a totally GRAPHICAL manner at any nearly any position on the screenπ'with the width and numerical display programmer defined!ππ'It's really neat, and I spent only marginal time creating it.  Itπ'also restores the previous color/cursor position from where the routineπ'was called, so NO need to worry with that stuff.  It's something Iπ'am most proud of, and also - it's fast.  Thanks to Brian who earlierπ'posted tips on screen color restore, showing we all share but giveπ'credit where credit is due.ππ'You can supply the width,x,y positions and other criteria like a normalπ'function, and tie it into loops to display real time percentbars.ππ'The output will resemble this (for example):ππ'┌─────────────────┤500/1000├──────────────────┐π'│50%  ▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓■■■■■■■■■■■■■■■■■■■■│π'└─────────────────────────────────────────────┘ππ'┌─────────────────────────────────────────────┐π'│50%  ▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓■■■■■■■■■■■■■■■■■■■■│π'└─────────────────────────────────────────────┘ππ'The first one shows the graphics bar (the progress graphics reallyπ'are spaces, but for purposes of this echo msg, are graphical boxes instead)π'WITH numerical values displayed, the second without.  Note that theπ'numerical displays automatically format the box, so the output is cleanπ'and does not include unnecessary spaces and so forth.  Cool, huh?ππ' PERCENTAGE BAR ROUTINE - WORKS FORWARD OR BACKWARDS OR STATIC VALUE!π' by JAMES GOLDBLOOM with color restore method courtesy of Brian McLaughlinπ' Public domain code - distribute freely and enjoy (3/8/96 PB 3.x)ππ' Syntax shown below:π'π' call percentbar (valuebar,lowbar,highbar,ybar,xbar,widthbar,showvalues)π'π' Where:  valuebar    =    current value of operation within the rangeπ'         lowbar      =    lowest possible (or beginning) value of rangeπ'         highbar     =    highest possible (or ending) value of rangeπ'         ybar        =    cursor line to place percentbar (y axis)π'         xbar        =    corsor row to place percentbar (x axis)π'         widthbar    =    width of percentbar dots (in columns) (max 72)π'                          and suggest values: 12,18,40,50,72 (they work.)π'         showvalues  =    0|1 (1 to display current/high valuees, 0=off)π'π' All values should be positive, but decimals are allowed.  Widthbarπ' seems to look the nicest at 72 (which is the limit.) Remember to freezeπ' the cursor by suffixing print/screen output statements with semi-colonsπ' to preserve the colors and x,y positions properly within your loops.π'π' Use this routine for progress display during file/dir. reads or ANY loopπ' operations by merely calling it using data from YOUR loops fed into it!π' Shows actual percentage (0-100%) to left of bar, automatically!π' Last color attribute/screen x,y position automatically preserved on exit!π' Work with high to low ranges, or low to high ranges (try it backwards!)π' Loops not required, you can optionally show a bar with "50%" instantly!π'π' See the example below, mess with the ranges...ππclsπcolor 11,0πprint "PERCENT BAR Stupid but Powerful Demonstration...."πprintπprint "This is an instant loop, 50%:";πcall percentbar (50,1,100,csrlin,pos+2,36,0)πlocate 7,1πprint "Another instant loop (values shown), 75%:";πcall percentbar (75,1,100,csrlin,pos+2,20,1)πlocate 11,1πprint "THIS PROGRAM CAN ALSO BE USED WITHIN LOOPS, FOR/NEXT'S, ETC.!"πprint:print "A good range to test would be 1 to 10000"πprint "And you can work backwards, too, such as 10000 to 1!":printπinput "Type in starting number";begin:if begin=0 then endπinput "Type in ending number";finish:if finish=0 then endπdirection=1:if begin>finish then direction=-1πfor count=begin to finish step directionπlocate 19,1:color 10:print"Current loop value:"count"...";πcall percentbar (count,begin,finish,23,1,72,1)πnext countπprint" Finished!"πprint "Nifty, huh?  Examine the code, see how it was done!"πendπππ'BELOW IS THE SUB ROUTINE...ππ'-----------------------------------------------------------------------π'PERCENTBAR Sub-Routine written by James Goldbloom 1:109/[e-mail]π'-----------------------------------------------------------------------π'π'Example:  percentbar (50,1,100,24,1,72)  <-- Display a 50% bar at bottom!π'                                             of screen!π'πSUB PERCENTBAR (valuebar,lowbar,highbar,ybar,xbar,widthbar,showvalues)πoldy=csrlin:oldx=pos(0):if oldx=1 then oldx=2 else if oldx=80 then oldx=81πif widthbar>72 then widthbar=72πfore%=screen(oldy,oldx-1,1)πback%=fore%:fore%=fore% and 15:shift right back%,4πif lowbar>highbar then swap highbar,lowbarπpercentage=int((valuebar/highbar)*100)πlocate ybar,xbar:color 9,0πif showvalues=0 then print chr$(218)repeat$(widthbar+5,chr$(196))chr$(191);πif showvalues=1 thenπ  tempbar$=mid$(str$(valuebar),2)+"/"+mid$(str$(highbar),2)π  print chr$(218)repeat$(int(widthbar/2)-1,chr$(196))chr$(180);:color 15π  print tempbar$;:color 9:print chr$(195);π  print repeat$(widthbar-((widthbar/2)+len(tempbar$))+4,chr$(196))chr$(191);πend ifπlocate ybar+1,xbar:color 9:πprint chr$(179);:color 14πprint mid$(str$(percentage),2)"%"space$(5-len(str$(percentage)));πdrawbar=int((widthbar*percentage)/100)πlocate ybar+1,xbar+6:color 1,1:print repeat$(drawbar,chr$(32));πif (widthbar-drawbar)<>1 thenπ color 11,0:print repeat$(widthbar-drawbar,chr$(254));π color 9:print chr$(179);πend ifπcolor 9,0:locate ybar+2,xbarπprint chr$(192)repeat$(widthbar+5,chr$(196))chr$(217);πEXITBAR:πlocate oldy,oldx:color fore%,back%πtempbar$="":tempbar=0:tempbarlength=0πdrawbar=0:percentage=0:ybar=0:xbar=0πEND SUBπDave Navarro, Jr.              SWAP ARRAYS IN PB              comp.lang.basic.misc           04-04-96 (06:50)       PB                     94   3029     SWAPARRY.BAS'  The following example shows how useful ArrayInfo() is.π'π'  It will allow you to completely swap two arrays of like type andπ'  element size.π'π'  Swapping each element individually is slow, and all we really need toπ'  do is swap the array descriptors.π'π'  Use at your own risk!π'π'  Donated to the Public Domainπ'  by Dave Navarro, Jr.ππ%TotalElements   = 1π%ElementSize     = 2π%ElementsPerPage = 3π%ArrayType       = 4π%SubscriptCount  = 5ππDEFINT A-ZππDECLARE FUNCTION ArrayInfo(BYVAL Code%, BYVAL Pointr AS DWORD) AS LONGππDIM X(1:5)πDIM Y(1:5)ππX(1) = 200            'assign a value to the first element of XππPRINT X(1), Y(1)      'print the value of X(1) and Y(1)ππArraySwap X(), Y()    'Do NOT use element numbers.  Empty parenthesisπ                      ' tell PowerBASIC to pass the array descriptor.ππPRINT X(1), Y(1)      'print the value of X(1) and Y(2), should be swappedππENDππSUB ArraySwap(ANY, ANY) PUBLICππ  DIM Pointer1 AS DWORDπ  DIM Pointer2 AS DWORDπ  DIM Temp AS STRING * 64ππ  ! push DSππ  ! les  DI, [BP+10]           ;get pointer to first arrayπ  ! mov  Pointer1[0], DI       ;store offset in Pointer1π  ! mov  Pointer1[2], ES       ;store segment in Pointer1ππ  ! les  DI, [BP+6]            ;get pointer to second arrayπ  ! mov  Pointer2[0], DI       ;store offset in Pointer2π  ! mov  Pointer2[2], ES       ;store segment in Pointer2ππ  ! pop  DSππ  'If either array is not dimensioned, then exitπ  IF (ArrayInfo(%TotalElements, Pointer1) * ArrayInfo(%TotalElements, Pointer2)) = 0 THENπ    EXIT SUBπ  END IFππ  'If both array types match, swap the descriptorsπ  ' make sure the element sizes are the same in case of fixed lengthπ  IF (ArrayInfo(%ArrayType, Pointer1) = ArrayInfo(%ArrayType, Pointer2)) AND (ArrayInfo(%ElementSize, Pointer1) = ArrayInfo(%ElementSize, Pointer2)) THENππ     ! push DSππ     ! lds  SI, [BP+6]         ;point to second arrayπ     ! lea  BX, Temp           ;point BX at Temp bufferπ     ! mov  DI, BX             ;put offset in DIππ     ! push DI                 ;save offset for laterπ     ! push SS                 ;save segment for laterππ     ! push SS                 ;push stack segment on the stackπ     ! pop  ES                 ;and put it in ESπ     ! mov  CX, 32             ;descriptor is 32 words longπ     ! rep  movsw              ;copy descriptor to temp bufferππ     ! lds  SI, [BP+10]        ;point to first arrayπ     ! les  DI, [BP+6]         ;point to second arrayπ     ! mov  CX, 32             ;descriptor is 32 words longπ     ! rep  movsw              ;copy first descriptor to second descriptorππ     ! les  DI, [BP+10]        ;point to first arrayπ     ! pop  DS                 ;restore segment of Temp bufferπ     ! pop  SI                 ;restore offset of Temp bufferπ     ! mov  CX, 32             ;descriptor is 32 words longπ     ! rep  movsw              ;copy second descriptor to first descriptorππ     ! pop  DSππ  END IFππEND SUBπMike Huff                      MIDI CODE FOR THE SBSIM        FidoNet QUIK_BAS Echo          03-23-96 (00:04)       QB, PDS                28   998      MIDI.BAS    'Here's some of the MIDI code for the SBSIM (Sound Blaster Simplified Interfaceπ'Module) driver. It plays in the background (of course).π'Make sure to load SBMIDI.EXE first then load SBSIM.COM next.π'Ohh, and also make sure SBSIM say driver using interrupt 81h or whatever, butπ'make sure you see an "81h" when you load SBSIM or your machine will probablyπ'crash. This code can easily be modified to play CMFs, VOCs, and can be used toπ'control the mixer.ππ' $INCLUDE: 'QB.BI'πDIM InRegs AS RegType, OutRegs AS RegTypeπFilename$ = "JAZZ.MID" + CHR$(0) 'make ASCIIZ stringππ' this initializes the driver and loads the MIDI.πInRegs.ax = SADD(Filename$)πInRegs.bx = 0 + 5 * 256πInRegs.dx = VARSEG(Filename$)πInterrupt &H81, InRegs, OutRegsπIF NOT OutRegs.ax THEN PRINT "MIDI sucessfully started!"ππ' this starts playing the MIDI.πInRegs.bx = 1 + 5 * 256πInterrupt &H81, InRegs, OutRegsππSLEEPππ' this stops the MIDI.πInRegs.bx = 2 + 5 * 256πInterrupt &H81, InRegs, OutRegsπDave Navarro, Jr.              PB .WAV PLAYER                 www.powerbasic.com/source      03-27-96 (00:00)       PB                     107  3757     PLAYWAVE.BAS'=============================================================================π'                   Source code snippet: PowerBASIC for DOSπ'π' Original found at http://www.fys.ruu.nl/~bergmann/basic.htmlπ' converted to PowerBASIC by Dave Navarro, Jr.π' additional work by unknown author on CompuServeπ'π' Play wave files through the SoundBlaster.π'π'=============================================================================ππDEFINT A-ZππMaxTicks& = 1193180πSHARED WritePort%, MaxTicks&ππ'-Div.Init (maybe you get the filename from command line?πCLSπFILES ("*.WAV")πINPUT "Select Wave File"; VocFile$πVocFile% = FREEFILEππ'-open the voc-fileπOPEN VocFile$ FOR BINARY AS #VocFile%ππTestPort$ = ENVIRON$("BLASTER")πIF TestPort$ > "" THENπ  PortAddress$ = "&H" + MID$(TestPort$, 2, 3)π  PortAddress = VAL(PortAddress$)π  WritePort = PortAddress + 12πELSEπ  WritePort = &H22CπEND IFππ'-parameters for copy-to-soundblasterπBytes& = LOF(VocFile%)                 'number of bytesπX$ = SPACE$(40) 'riff file header stuffπGET #VocFile, , X$πSpeed = ASC(MID$(X$, 26, 1)) * 256 OR ASC(MID$(X$, 25, 1))ππ'Playrate in Bytes per second.π'We are assuming an 8 bit *.Wav File Hereπ' And my 386-16 will hang in there at 11025 BPS under DOSπClocks = MaxTicks& \ Speed 'using an integer divide. Close enoughπ                           'and doesn't pull in floating point math packπ                           'Maxticks are for the "normal" PC Clock atπ                           '18.206 + ticks per second.π                           'We'll use this to time the play rate.πBytes& = Bytes& - 40πBytesRemaining& = Bytes&               'number of remaining bytesπBufferMax% = &H3F00                    'largest bufferπBuffer$ = SPACE$(BufferMax%)           'create bufferπSetVoice 1                             'Soundblaster onππ'-read {BufferMax%} bytes from disc, output on SBπDOπ  BytesRemaining& = BytesRemaining& - BufferLen%π  IF BytesRemaining& = 0 THEN EXIT DO  'nothing left over?π  IF BytesRemaining& > BufferMax% THEN 'how many bytes?π    BufferLen% = BufferMax%π  ELSEπ    BufferLen% = BytesRemaining&       'remaining (<BufferMax%)..π    Buffer$ = SPACE$(BufferLen%)       '..throw it into SB :-)π  END IFππ  GET #VocFile%, , Buffer$             'read buffeerπ  T = 0π  DEF SEG = STRSEG(Buffer$)π  K = STRPTR(Buffer$)π  OUT &H43, &H34 'PIT Timer select one shot then we can let theπ  OUT &H40, 0  'clock keep up.π  OUT &H40, 0  ' set the clock to 0 and start the count downπ  Rate& = 65536 - Clocks 'First count down stopping valueπ                         ' "zero" - Rateπ  DO             'output od {bufferlen%}π     Char = PEEK(K + T)π     WAIT WritePort, &H80, &HFF             'wait for data-readyπ     OUT WritePort, &H10π     WAIT WritePort, &H80, &HFFπ     OUT WritePort, Char 'Direct DAC methodπ     T = T + 1π     DOπ      C& = (INP(&H40) + INP(&H40) * 256&) 'check the tickerπ    LOOP UNTIL C& <= Rate& 'end if it's at or below the ticks we allotedπ    Rate& = Rate& - Clocksπ    IF Rate& < 0 THENπ        OUT &H40, 0  'reset the ticker to 0π        OUT &H40, 0  'both bytesπ        Rate& = 65536 - Clocks  'Reset the Rate& valueπ    END IFπ  LOOP UNTIL T = BufferLen 'This is faster than a for next loopπ  OUT &H43, 4πLOOP UNTIL ForeverπSetVoice 0                             'SB offπCLOSE #VocFile%                        'close fileπEND                                    '.. good bye :-)ππ' Turns Speaker on and offπSUB SetVoice (OnOff%)π  IF OnOff% THENπ    WAIT WritePort%, &H80, &HFF             'wait for data-ready on SBπ    OUT WritePort%, &HD1 'ONπ  ELSEπ    WAIT WritePort%, &H80, &HFFπ    OUT WritePort%, &HD3 'OFFπ  END IFπEND SUBπMike Huff                      BACKGROUND WAV/VOC PLAY/RECORD [e-mail]                  03-30-96 (23:48)       QB, QBasic, PDS, VBDOS 377  10169    DMAPLAY.BAS ' DMA Playπ' By Mike Huff (1996)π' Audio file player that plays using the DMA channels.π' Runs in QBASIC, QuickBASIC, PDS, VBDOS, and even GW-BASIC!!! (If you addπ' line numbers and remove the SUBs, FUNCTIONS, and do a few other things.)π' Use DMADone% to detect the end of a transfer.π' Tested on a 486DX4-120mHz with a Reveal Sound FX card.πDECLARE FUNCTION SpeakerStatus% ()πDECLARE FUNCTION DMAStatus% ()πDECLARE FUNCTION DMADone% ()πDECLARE FUNCTION ResetDSP% ()πDECLARE SUB FMVolume (Right%, Left%, Getvol%)πDECLARE SUB VocVolume (Right%, Left%, Getvol%)πDECLARE SUB MasterVolume (Right%, Left%, Getvol%)πDECLARE SUB MicVolume (Gain%, Getvol%)πDECLARE SUB LineVolume (Right%, Left%, Getvol%)πDECLARE SUB CDVolume (Right%, Left%, Getvol%)πDECLARE SUB InputSource (InputSrc%, GetSrc%)πDECLARE SUB WriteDSP (byte%)πDECLARE SUB SetStereo (OnOff%)πDECLARE FUNCTION ReadDSP% ()πDECLARE SUB WriteDAC (byte%)πDECLARE SUB SpeakerState (OnOff%)πDECLARE SUB DMAState (StopGo%)πDECLARE FUNCTION ReadDAC% ()πDECLARE SUB DMAPlay (Segment&, Offset&, Length&, Freq&)πDECLARE SUB DMARecord (Segment&, Offset&, Length&, Freq&)πDECLARE SUB GetBLASTER (DMA%, BasePort%, IRQ%)πDECLARE FUNCTION DSPVersion! ()πCOMMON SHARED BasePort%, LenPort%, Channel%ππCLSπPRINT "DMAPlay"πPRINT "By Mike Huff"πPRINT "The first background WAV/VOC/etc player/recorder in BASIC I've ever seen"πPRINT "Use freely"πPRINT "Comments, etc. can be sent to [e-mail] or on FidoNet in the QUIK_BAS echo"πGetBLASTER Channel%, BasePort%, IRQ% ' Parses BLASTER environmentπPRINT STRING$(80, 196)πIF ResetDSP% THEN 'resets DSP (returns true if sucessful)π   PRINT "DSP reset sucessfully!"πELSEπ   PRINT "DSP failed to reset, try another port."πEND IFππSpeakerState 1 'turn the speaker onπPRINT "Sound Card DSP version:"; DSPVersion!ππMasterVolume Right%, Left%, -1 'this puts the mixer volumes in Right% and Left%πPRINT "Master volume is set at: Right-"; Right%; " Left-"; Left%πMasterVolume 15, 15, 0 'this cranks the master volume all the way up.ππDIM WavBuffer(1 TO 1) AS STRING * 32767 'Make a 32k buffer for file.πINPUT "WAV/VOC/SND file to play: ", Filename$πOPEN Filename$ FOR BINARY AS #1πGET #1, 44, WavBuffer(1) 'Get 32k from file (skip header on WAV)ππLength& = LOF(1) - 44πIF Length& > 32767 THEN Length& = 32767 'Adjust length if needed to 32kππINPUT "Frequency to play at: (1000-41000Hz)", Freq&πDMAPlay VARSEG(WavBuffer(1)), VARPTR(WavBuffer(1)), Length&, Freq&ππ'Use DMARecord to record in the background.π'and use DMAPlay to playback the same buffer you recorded to or you couldπ'even write the buffer to a file.π'DMARecord VARSEG(WavBuffer(1)), VARPTR(WavBuffer(1)), Length&, Freq&ππDOπCOLOR RND * 15πPRINT "Check it out! It's playing in the background!"πLOOP UNTIL DMADone%ππCLSπCOLOR 7πPRINT "DMA transfer completed!"ππSUB CDVolume (Right%, Left%, Getvol%)πOUT BasePort% + 4, &H28πIF Getvol% THENπ   Left% = INP(BasePort% + 5) \ 16π   Right% = INP(BasePort% + 5) AND &HFπ   EXIT SUBπELSEπ   OUT BasePort% + 5, (Right% + Left% * 16) AND &HFFπEND IFπEND SUBππFUNCTION DMADone%πCount% = INP(LenPort%)πCount2% = INP(LenPort%)πCount& = CLNG(Count% + 1) * CLNG(Count2% + 1)πIF (Count& - 1) >= &HFFFF& THEN junk% = INP(DSPDataAvail%): DMADone% = -1πEND FUNCTIONππSUB DMAPlay (Segment&, Offset&, Length&, Freq&)π' Transfers and plays the contents of the buffer.πLength& = Length& - 1πPage% = 0πMemLoc& = Segment& * 16 + Offset&πSELECT CASE Channel%π    CASE 0π       PgPort% = &H87π       AddPort% = &H0π       LenPort% = &H1π       ModeReg% = &H48π    CASE 1π       PgPort% = &H83π       AddPort% = &H2π       LenPort% = &H3π       ModeReg% = &H49π    CASE 2π       PgPort% = &H81π       AddPort% = &H4π       LenPort% = &H5π       ModeReg% = &H4Aπ    CASE 3π       PgPort% = &H82π       AddPort% = &H6π       LenPort% = &H7π       ModeReg% = &H4Bπ    CASE ELSEπ       PRINT "DMA channels 0-3 only are supported."π       EXIT SUBπEND SELECTππOUT &HA, &H4 + Channel%πOUT &HC, &H0πOUT &HB, ModeReg%πOUT AddPort%, MemLoc& AND &HFFπOUT AddPort%, (MemLoc& AND &HFFFF&) \ &H100πIF (MemLoc& AND 65536) THEN Page% = Page% + 1πIF (MemLoc& AND 131072) THEN Page% = Page% + 2πIF (MemLoc& AND 262144) THEN Page% = Page% + 4πIF (MemLoc& AND 524288) THEN Page% = Page% + 8πOUT PgPort%, Page%πOUT LenPort%, Length& AND &HFFπOUT LenPort%, (Length& AND &HFFFF&) \ &H100πOUT &HA, Channel%ππIF Freq& < 23000 THENπ   TimeConst% = 256 - 1000000 \ Freq&π   WriteDSP &H40π   WriteDSP TimeConst%π   WriteDSP &H14π   WriteDSP (Length& AND &HFF)π   WriteDSP ((Length& AND &HFFFF&) \ &H100)πELSEπ   IF DSPVersion! >= 3 THENπ      TimeConst% = ((65536 - 256000000 \ Freq&) AND &HFFFF&) \ &H100π      WriteDSP &H40π      WriteDSP TimeConst%π      WriteDSP (Length& AND &HFF)π      WriteDSP ((Length& AND &HFFFF&) \ &H100)π      WriteDSP &H91π   ELSEπ      PRINT "You need a Sound Blaster with a DSP v3.x+ to play at high speed."π      EXIT SUBπ   END IFπEND IFπEND SUBππSUB DMARecord (Segment&, Offset&, Length&, Freq&)πLength& = Length& - 1πMemLoc& = Segment& * 16 + Offset&πPage% = 0πSELECT CASE Channel%π    CASE 0π       PgPort% = &H87π       AddPort% = &H0π       LenPort% = &H1π       ModeReg% = &H44π    CASE 1π       PgPort% = &H83π       AddPort% = &H2π       LenPort% = &H3π       ModeReg% = &H45π    CASE 2π       PgPort% = &H81π       AddPort% = &H4π       LenPort% = &H5π       ModeReg% = &H46π    CASE 3π       PgPort% = &H82π       AddPort% = &H6π       LenPort% = &H7π       ModeReg% = &H47π    CASE ELSEπ       EXIT SUBπEND SELECTππOUT &HA, &H4 + Channel%πOUT &HC, &H0πOUT &HB, ModeReg%πOUT AddPort%, MemLoc& AND &HFFπOUT AddPort%, (MemLoc& AND &HFFFF&) \ &H100πIF (LongByte& AND 65536) THEN Page% = Page% + 1πIF (LongByte& AND 131072) THEN Page% = Page% + 2πIF (LongByte& AND 262144) THEN Page% = Page% + 4πIF (LongByte& AND 524288) THEN Page% = Page% + 8πOUT PgPort%, Page%πOUT LenPort%, Length& AND &HFFπOUT LenPort%, (Length& AND &HFFFF&) \ &H100πOUT &HA, Channel%ππIF Freq& <= 23000 THENπ   TimeConst% = 256 - 1000000 \ Freq&π   WriteDSP &H40π   WriteDSP TimeConst%π   WriteDSP &H24π   WriteDSP (Length& AND &HFF)π   WriteDSP ((Length& AND &HFFFF&) \ &H100)πELSEπ   IF DSPVersion! >= 3 THENπ      TimeConst% = ((65536 - 256000000 / Freq&) AND &HFFFF&) \ &H100π      WriteDSP &H40π      WriteDSP TimeConst%π      WriteDSP (Length& AND &HFF)π      WriteDSP ((Length& AND &HFFFF&) \ &H100)π      WriteDSP &H99π   ELSEπ      PRINT "You need a Sound Blaster with a DSP 3.x+ to record at high speed."π      EXIT SUBπ   END IFπEND IFππEND SUBππSUB DMAState (StopGo%)π' Stops or continues DMA play.πIF StopGo% THEN WriteDSP &HD4 ELSE WriteDSP &HD0ππEND SUBππFUNCTION DSPVersion!π' Gets the DSP version.πWriteDSP &HE1πTemp% = ReadDSP%πTemp2% = ReadDSP%πDSPVersion! = VAL(STR$(Temp%) + "." + STR$(Temp2%))πEND FUNCTIONππSUB FMVolume (Right%, Left%, Getvol%)πOUT BasePort% + 4, &H26πIF Getvol% THENπ   Left% = INP(BasePort% + 5) \ 16π   Right% = INP(BasePort% + 5) AND &HFπ   EXIT SUBπELSEπ   OUT BasePort% + 5, (Right% + Left% * 16) AND &HFFπEND IFπEND SUBππSUB GetBLASTER (DMA%, BasePort%, IRQ%)π' This subroutine parses the BLASTER environment string and returns settings.πIF LEN(ENVIRON$("BLASTER")) = 0 THEN PRINT "BLASTER environment variable not set.": EXIT SUBπFOR Length% = 1 TO LEN(ENVIRON$("BLASTER"))π   SELECT CASE MID$(ENVIRON$("BLASTER"), Length%, 1)π      CASE "A"π        BasePort% = VAL("&H" + MID$(ENVIRON$("BLASTER"), Length% + 1, 3))π      CASE "I"π        IRQ% = VAL(MID$(ENVIRON$("BLASTER"), Length% + 1, 1))π      CASE "D"π        DMA% = VAL(MID$(ENVIRON$("BLASTER"), Length% + 1, 1))π   END SELECTπNEXTππEND SUBππSUB InputSource (InputSrc%, GetSrc%)πOUT BasePort% + 4, &HCπIF GetSrc% THENπ   InputSrc% = INP(BasePort% + 5) AND 2 + INP(BasePort% + 5) AND 4πELSEπ   OUT BasePort% + 5, InputSrc% AND 7πEND IFπEND SUBππSUB LineVolume (Right%, Left%, Getvol%)πOUT BasePort% + 4, &H2EπIF Getvol% THENπ   Left% = INP(BasePort% + 5) \ 16π   Right% = INP(BasePort% + 5) AND &HFπ   EXIT SUBπELSEπ   OUT BasePort% + 5, (Right% + Left% * 16) AND &HFFπEND IFπEND SUBππSUB MasterVolume (Right%, Left%, Getvol%)πOUT BasePort% + 4, &H22π'PRINT BasePort%πIF Getvol% THENπ   Left% = INP(BasePort% + 5) \ 16π   Right% = INP(BasePort% + 5) AND &HFπ   EXIT SUBπELSEπ   OUT BasePort% + 5, (Right% + Left% * 16) AND &HFFπEND IFπEND SUBππSUB MicVolume (Volume%, Getvol%)πOUT BasePort% + 4, &HAπIF Getvol% THENπ   Volume% = INP(BasePort% + 5) AND &HFπ   EXIT SUBπELSEπ   OUT BasePort% + 5, Volume% AND &HFπEND IFπEND SUBππFUNCTION ReadDAC%π' Reads a byte from the DAC.πWriteDSP &H20πReadDAC% = ReadDSP%ππEND FUNCTIONππFUNCTION ReadDSP%π' Reads a byte from the DSPπDOπLOOP UNTIL INP(BasePort% + 14) AND &H80πReadDSP% = INP(BasePort% + 10)πEND FUNCTIONππFUNCTION ResetDSP%π' Resets the DSPπOUT BasePort% + 6, 1πFOR Count% = 1 TO 4π   junk% = INP(BasePort% + 6)πNEXTπOUT BasePort% + 6, 0πIF INP(BasePort% + 14) AND &H80 = &H80 AND INP(BasePort% + 10) = &HAA THENπ   ResetDSP% = -1πELSEπ   ResetDSP% = 0πEND IFπEND FUNCTIONππSUB SetStereo (OnOff%)πOUT BasePort% + 4, &HEπIF OnOff% THEN OUT BasePort% + 5, 2 ELSE OUT BasePort% + 5, 0πEND SUBππSUB SpeakerState (OnOff%)π' Turns speaker on or off.πIF OnOff% THEN WriteDSP &HD1 ELSE WriteDSP &HD3πEND SUBππFUNCTION SpeakerStatus%πOUT BasePort% + 4, &HD8πIF INP(BasePort% + 5) = &HFF THEN SpeakerStatus% = -1 ELSE SpeakerStatus% = 0πEND FUNCTIONππSUB VocVolume (Right%, Left%, Getvol%)πOUT BasePort% + 4, &H4πIF Getvol% THENπ   Left% = INP(BasePort% + 5) \ 16π   Right% = INP(BasePort% + 5) AND &HFπ   EXIT SUBπELSEπ   OUT BasePort% + 5, (Right% + Left% * 16) AND &HFFπEND IFπEND SUBππSUB WriteDAC (byte%)π' Writes a byte to the DAC.πWriteDSP &H10πWriteDSP byte%πEND SUBππSUB WriteDSP (byte%)π' Writes a byte to the DSPπDOπLOOP WHILE INP(BasePort% + 12) AND &H80πOUT BasePort% + 12, byte%πEND SUBπAndrew Jones                   SOUND BLASTER OSCILLISCOPE     FidoNet QUIK_BAS Echo          04-14-96 (14:48)       QB, QBasic, PDS        88   1619     SBOSCILL.BAS'And here's my sound blaster oscilliscope.ππDEFINT A-ZπCLSπCOLOR 9πPRINT "NanoSoft Osci-Trip"πCOLOR 15πPRINT "Sound Blaster routines by Gary Maddox, obtained from SB-Digest Issue #5"πPRINTπ BPORT = &H210π XPORT = &H216π WPORT = &H21Cπ RPORT = &H21Aπ APORT = &H21Eπ READY = &HAAπDOπ   OUT XPORT, 1π π   FOR t = 0 TO 10π   ll! = TIMERπ   DOπ   LOOP WHILE ll! = TIMERπ   NEXTπ   OUT XPORT, 0π   loopctr = 0π   DOπ     byte = INP(RPORT)π     loopctr = loopctr + 1π   IF byte = &HAA THEN EXIT DOπ   IF loopctr > 100 THEN EXIT DOπ   LOOPπ   IF byte <> &HAA THENπ     BPORT = BPORT + &H10π     XPORT = XPORT + &H10π     WPORT = WPORT + &H10π     RPORT = RPORT + &H10π π     APORT = APORT + &H10π   END IFπ IF byte = &HAA THEN EXIT DOπ IF RPORT = &H270 THEN EXIT DOπ LOOPπ π IF BPORT = &H270 THENπ   PRINT "Sound Blaster Not Found!"π   STOPπ ELSEπ   PRINT "Sound Blaster Installed at Port:"; HEX$(BPORT)π END IFπ  PRINT "Press a key, press escape to quit."π  DOπ  LOOP UNTIL LEN(INKEY$)π  SCREEN 13π  ext = FALSEπFOR t = 0 TO 199πLINE (0, t)-(319, t), tπNEXTπFOR x = 0 TO 319 STEP 40πFOR y = 0 TO 199 STEP 40πFOR v = 0 TO 20πCIRCLE (x + 20, y + 20), v, 200 - (v + y)πCIRCLE (x + 21, y + 20), v, 200 - (v + y)πNEXTπNEXTπNEXTπ πDOπ    OUT &H3C8, 1π    FOR t = 1 TO 200 STEP 10π    OUT WPORT, &H20π πbyte = INP(RPORT)πFOR x = 0 TO 10πOUT &H3C9, byte + (x * 6)πOUT &H3C9, (byte + (x * 6)) \ 2πOUT &H3C9, (byte + (x * 6)) \ 4πNEXTπNEXTπ πIF INKEY$ = CHR$(27) THEN ext = 1π'lastbyte = byteπLOOP UNTIL extπSCREEN 0πWIDTH 80πCLSπPRINT "Bye."πENDππDaniel Minty                   SOUND AFFECTS                  [e-mail]             04-23-96 (07:15)       QB, QBasic, PDS        131  3150     SAFFECTS.BAS'Sound Effectsπ'Mostly made by Daniel Minty e-mail:  [e-mail]π'OR home page: (http://wsite.com/Daniel/index.html)πCLSπPRINT "0"π0 PLAY "MBO0L32EFGEFDC"πSLEEPπPRINT "1"π1 PLAY "T120L16MLO3BF#"πSLEEPπPRINT "2"π2 PLAY "T255L64MLO4BAGFEDC<BAGFEDEC<BAGFEDC<BAGFEDC<BAGFEDC"πSLEEPπPRINT "3"π3 PLAY "T255L32O4mlDGD<G>DGDDGDGBAGF#EE"πSLEEPπPRINT "4"π4 PLAY "T255L64MLO2BCADGEFEGDACBCADGEFEGDACB"πSLEEPπPRINT "5"π5 PLAY "T255L64MLO3BCADGEFEGDACBCADGEFEGDACB"πSLEEPπPRINT "6"π6 PLAY "T255L64MLO4BCADGEFEGDACBCADGEFEGDACB"πSLEEPπPRINT "7"π7 PLAY "T255L64MLO5BCADGEFEGDACBCADGEFEGDACB"πSLEEPπPRINT "8"π8 PLAY "T150L64MSO4BGEC<AFL16D"πSLEEPπPRINT "9"π9 PLAY "T150L64MSO4BFC<GD<AL16E"πSLEEPπPRINT "10"π10 PLAY "T150L64MSO4BE<AD<GC<L32F"πSLEEPπPRINT "11"π11 PLAY "T150L64MSO3DFA>CEGL16B"πSLEEPπPRINT "12"π12 PLAY "T120L64MSO2E.A.>D.G.>C.F.B."πSLEEPπPRINT "13"π13 PLAY "T150L64MSO0F>CG>DA>EB."πSLEEPπPRINT "14"π14 PLAY "T240L64MLO4EGEGEGCFCFCFGEGEGE"πSLEEPπPRINT "15"π15 PLAY "T255L64O4CDEFGABO3CDEFGABO2CDEFGAB"πSLEEPπPRINT "16"π16 PLAY "T255L64MLO1BAGFEDC<BAGFEDCP16>CDEFGAB>CDEFGABP32"πSLEEPπPRINT "17"π17 PLAY "T255L64MLO2BAGFEDC<BAGFEDCP16>CDEFGAB>CDEFGABP32"πSLEEPπPRINT "18"π18 PLAY "T255L64MLO3BAGFEDC<BAGFEDCP16>CDEFGAB>CDEFGABP32"πSLEEPπPRINT "19"π19 PLAY "T255L64MLO4BAGFEDC<BAGFEDCP16>CDEFGAB>CDEFGABP32"πSLEEPπPRINT "20"π20 PLAY "T255L64MLO1CDEFGAB>CDEFGABP16<BAGFEDC<BAGFEDCP32"πSLEEPπPRINT "21"π21 PLAY "T255L64MLO2CDEFGAB>CDEFGABP16<BAGFEDC<BAGFEDCP32"πSLEEPπPRINT "22"π22 PLAY "T255L64MLO3CDEFGAB>CDEFGABP16<BAGFEDC<BAGFEDCP32"πSLEEPπPRINT "23"π23 PLAY "T255L64MLO4CDEFGAB>CDEFGABP16<BAGFEDC<BAGFEDCP32"πSLEEPπPRINT "24"π24 PLAY "T120L16O4C#.P16T255L64mlC#DD#EFF#GG#AA#BO5CC#DD#EF"πSLEEPπPRINT "25"π25 PLAY "T255L32mlO3CD<CD>>CD<<CD>>CD<<CD>CD"πSLEEPπPRINT "26"π26 PLAY "T240L64MLO4EGEGEGEGEGEGEGEGEGEGEGEGEGEGEG"πSLEEPπPRINT "27"π27 PLAY "O4T255L64MLB-BB-BAGAG.>EGG>EGG"πSLEEPπPRINT "28"π28 PLAY "T200L64MLO4C#DD#EFF#GG#AA#B>CC#DD#EFP8.<C#DD#EFF#GG#AA#B>CC#DD#EFED#DC#"πSLEEPπPRINT "29"π29 PLAY "T255L64MsO4C#DD#EFF#GG#AA#B>CC#DD#EF"πSLEEPπPRINT "30"π30 PLAY "MBO0L32EFGEFDC"πSLEEPπPRINT "31"π31 PLAY "MBO2l32abebcfdfg"πSLEEPπPRINT "32"π32 PLAY "T120L16O4C#.P16T255L64mlC#DD#EFF#GG#AA#BO5CC#DD#EF#T120L16O4C.P16T255L64mlCDDEFFGGAABO5CCDDEF"πSLEEPπPRINT "33"π33 PLAY "T2553L64MSO4CDDEFFGGAABCCDDEF"πSLEEPπPRINT "34"π34 PLAY "T240L64MLO4CECECECECECECADADADADADADADADADFGFGFGFGFGFGFG"πSLEEPπPRINT "35"π35 PLAY "T2553L64MSO4CDEFGACDEFGACDEFGACDEFGACDEFGACDEFGACDEFGA"πSLEEPπPRINT "36"π36 PLAY "T240L64MLO4CECECECECECECECECECP2CECECECECECECECECECP1ECECECCECECECECECECP2CECECECECECECECECEC"πSLEEPπPRINT "37"π37 PLAY "T255L64MLO3ABCDEFG<ABCDEFG<ABCDEFG<ABCDEFG<ABCDEFG<ABCDEFG"πSLEEPπPRINT "38"π38 PLAY "T255L64MLO3ABCDEFGFEDCBABCDEFGFEDCBABCDEFGFEDCBABCDEFGFEDCBABCDEFGFEDCBA"πSLEEPπPRINT "39"π39 PLAY "MBO0L32cdcdcdcdcdcdcdcdcdcdcd"πSLEEPπPRINT "40"π40 PLAY "O4T255L64MLaaaabbbbccccddddeeeeffffggggffffeeeeddddccccbbbbaaaa"πSLEEPπPRINT "41"π41 PLAY "T255L32mlO3abcdefgabcdefgabcdefgabcdefgabcdefgabcdefg"πSLEEPππAlexander Podkolzin            SIMPLE FILE BROWSER            [e-mail]         02-29-96 (14:39)       PB32                   267  7463     BRWSFILE.BAS'--------------------------------------------------------------------------π' Simple File Browser. Author: Alexander Podkolzin <[e-mail]>π' Use it as you want...π' PowerBASIC 3.2π'--------------------------------------------------------------------------π$CPU 8086π$OPTIMIZE SIZEπ$COMPILE EXEπ$DEBUG MAP OFFπ$DEBUG PBDEBUG OFFπ$LIB ALL       OFFπ$ERROR ALL     OFFπ$COM    0π$STRING 4π$STACK  2048π$SOUND  1π$DIM ARRAYπ$DYNAMICπ$OPTION CNTLBREAK OFFπ'--------------------------------------------------------------------------π  %MaxLines = 5000                      ' Max strings to showπ  %MaxLen=240                           ' Max LEN of a stringπ'π  DEFINT a-zπ  DIM txt$(%MaxLines)π'π  InsKey$=CHR$(0,82)                    ' Key codesπ  Enter$=CHR$(13)π  Esc$ = CHR$(27)π  Home$ = CHR$(0,71)π  PgUp$ = CHR$(0,73)π  EndKey$ = CHR$(0,79)π  PgDn$ = CHR$(0,81)π  Up$ = CHR$(0,72)π  Down$ = CHR$(0,80)π  LeftKey$ = CHR$(0,75)π  RightKey$ = CHR$(0,77)π  CtrlPgUp$ = CHR$(0,132)π  CtrlPgDn$ = CHR$(0,118)π  CtrlHome$ = CHR$(0,119)π  CtrlEnd$ = CHR$(0,117)π'π  Twin%=1                               ' Win typeπ  xb%=1 : yb%=2 : xe%=80 : ye%=24       ' Edit window coordinatesπ'π  ct%=7                                 ' Main colorsπ  cb%=0                                 'π'π  FileName$ = COMMAND$                  ' File to editπ'π  IF NOT FileExists(FileName$) THENπ     PRINT "Command line <FileName> not found..."π     BEEPπ     ENDπ  END IFπ'π  src% = FREEFILEπ  OPEN FileName$ FOR INPUT AS src%π  i%=0π  DO WHILE EOF(src%)=0 AND i% < %MaxLinesπ     INCR i%π     LINE INPUT #src%,txt$(i%)π     IF txt$(i%)="" THEN txt$(i%)=" "π     REPLACE CHR$(9) WITH "        " IN txt$(i%)π  LOOPπ  CLOSE src%π  nlines%=i%π'π  COLOR 0,7π  LOCATE 1,1π  PRINT SPACE$(80);π  LOCATE 1,4π  PRINT "File = ";FileName$;π  LOCATE 25,1π  PRINT SPACE$(80);π'π  COLOR ct%,cb%π'π  lpage%=ye%-yb%-1π  CALL win(twin%,xb%,yb%,xe%,ye%,ct%,cb%)π  Aprint 3,ye%,"┤     :   =   ├"π'π  begx%=1π  begy%=1π  endy%=MIN(lpage%,nlines%)π  CurY%=1π  CurX%=1π  GOSUB ShowTextπ  GOSUB ShowCursorπ  DOπ     GOSUB ShowCursorπ     WHILE NOT INSTAT: WEND             ' begy% - first line to show,π     IF nlines%<1 THEN EXIT LOOP        ' endy% - last line to show (array)π     k$=INKEY$                          ' CurY%  - the cursor bar lineπ     SELECT CASE k$                     ' lpage%- length of window (page)π        CASE InsKey$π           : ITERATE LOOPπ        CASE Esc$π           : CurY%=0 : begy%=1:EXIT LOOPπ        CASE Enter$π           : EXIT LOOPπ        CASE Home$π           : CurX%=2 : begx%=1π        CASE EndKey$π           : l%=LEN(txt$(begy%+CurY%-1))π           : CurX%=MIN(l%+1,78)+1π           : endx%=MAX(l%+1,78)+1π           : begx%=endx%-78π        CASE Up$π           IF CurY%>1 THENπ              DECR CurY%π           ELSEπ              begy%=begy%-1π              endy%=endy%-1π           END IFπ        CASE Down$π           IF CurY%<lpage% THENπ              INCR CurY%π           ELSEπ              begy%=begy%+1π              endy%=endy%+1π           END IFπ        CASE LeftKey$π           IF CurX%>2 THENπ              DECR CurX%π           ELSEπ              begx%=begx%-1π              IF begx%<1 THEN begx%=1π           END IFπ        CASE RightKey$π           IF CurX% < 79 THENπ              INCR CurXπ              Show=0π           ELSEπ              INCR begxπ              IF begx >%MaxLen-79 THEN begx=%MaxLen-79π           END IFπ        CASE PgUp$π           : begy%=begy%-lpage%π           : endy%=endy%-lpage%π        CASE PgDn$π           : begy%=begy%+lpage%π           : endy%=endy%+lpage%π        CASE CtrlPgUp$π           : begy%=1π           : endy%=begy%+lpage%-1π           : CurX%=2π           : CurY%=1π        CASE CtrlPgDn$π           : endy%=nlines%π           : begy%=endy%-lpage%+1π           : CurX%=2π           : CurY%=21π        CASE CtrlHome$π           : CurY%=1π        CASE CtrlEnd$π           : CurY%=21π        CASE ELSEπ           : k$=""π     END SELECTπ     GOSUB ShowTextπ  LOOPπ  CLSπ  ENDπ'--------------------------------------------------------------------------ππShowText:π  CALL Numerer(nlines%,lpage%,begy%,endy%)π  GOSUB MakeRulerπ  FOR i%=begy% TO endy%π     Aprint xb%+1,yb%+i%-begy%+1,_π     MID$(txt$(i%)+SPACE$(xe%-xb%+1),begx%,78)π  NEXT i%π  RETURNπ'--------------------------------------------------------------------------ππShowCursor:π  LOCATE ye%,4,0π  PRINT RIGHT$("0000"+LTRIM$(STR$(begy%+CurY%-1)),5)π  LOCATE ye%,10,0π  PRINT RIGHT$("00"+LTRIM$(STR$(begx%+Curx%-2)),3)π  IF CurX%< 2 THEN CurX%= 2π  IF CurX%>79 THEN CurX%=79π  LOCATE ye%,14,0π  PRINT RIGHT$("00"+LTRIM$(STR$(SCREEN(CurY%+2,CurX%))),3)π  LOCATE yb%+CurY%,CurX,1π  RETURNπ'--------------------------------------------------------------------------ππMakeRuler:π  FOR i%=yb%+1 TO ye%-1π     Aprint xe%,i%,CHR$(177)π  NEXTπ  k%=((begy%+CurY%-1)/nlines%)*(ye%-yb%-1)π  IF k%=0 THEN k%=1π  Aprint xe%,yb%+k%,CHR$(219)π  RETURNπ'--------------------------------------------------------------------------π  SUB Numerer(nlines%,lpage%,begy%,endy%)π     IF nlines%<=lpage% THENπ        begy%=1π        endy%=nlines%π        EXIT SUBπ     END IFπ     IF begy%<1 THENπ        begy%=1π        endy%=begy%+lpage%-1π        EXIT SUBπ     END IFπ     IF begy%+lpage%-1>=nlines% THENπ        endy%=nlines%π        begy%=nlines%-lpage%+1π        EXIT SUBπ     END IFπ     endy%=begy%+lpage%-1π  END SUBπ'--------------------------------------------------------------------------π  SUB Win(t%,xb%,yb%,xe%,ye%,ct%,cb%)π'π     OldColor% = pbvScrnTxtAttr         ' Internal PB variableπ     SELECT CASE t%                     ' Window typesπ'                                       ' (you can make as much types,π'                                       '  as you want):π        CASE 1π           a%=218:b%=196:c%=191         '┌───────┐π           h%=179:      :d%=179         '│   1   │π           g%=192:f%=196:e%=217         '└───────┘π        CASE 2π           a%=201:b%=205:c%=187         '╔═══════╗π           h%=186:      :d%=186         '║   2   ║π           g%=200:f%=205:e%=188         '╚═══════╝π        CASE ELSEπ           a%=032:b%= a%:c%= a%         'π           h%= a%:      :d%= a%         ' Blanks onlyπ           g%= a%:f%= a%:e%= a%         'π     END SELECTπ     COLOR ct%,cb%π     LOCATE yb%,xb%π     PRINT CHR$(a%)+REPEAT$(xe%-xb%-1,CHR$(b%))+CHR$(c%);π     FOR i%=yb%+1 TO ye%-1π        LOCATE i%,xb%π        PRINT CHR$(h%)+ SPACE$(xe%-xb%-1) +CHR$(d%);π     NEXTπ     LOCATE ye%,xb%π     PRINT CHR$(g%)+REPEAT$(xe%-xb%-1,CHR$(f%))+CHR$(e%);π     ct%=OldColor% AND 15               ' restore colorsπ     cb%=OldColor%\16π     COLOR ct%,cb%π  END SUBπ'--------------------------------------------------------------------------π  SUB Aprint(x%,y%,st$)π     ox%=POS(0)π     oy%=CSRLINπ     LOCATE y%,x%,0π     PRINT st$;π     LOCATE oy%,ox%,1π  END SUBπ'--------------------------------------------------------------------------πFUNCTION FileExists%(FileName$)π  S$=DIR$(FileName$)π  IF LEN(S$) = 0 THENπ     FileExists% =  0π  ELSEπ     FileExists% = -1π  END IFπEND FUNCTIONπ'--------------------------------------------------------------------------πDouglas H. Lusher              80X28 TEXT MODE                FidoNet QUIK_BAS Echo          03-21-96 (16:01)       QB, PDS                30   895      80X28.BAS   ' > How can I put the screen in 80x28 textmode?ππ DEFINT A-Zπ '$INCLUDE: 'qb.bi'π DIM Reg AS RegTypeππ WIDTH , 43          'this is necessary so that BASIC will notπ                     '   complain if we attempt to use theπ                     '   LOCATE command on a row greater than 25ππ Reg.AX = &H1202                 'set up 400 scan linesπ Reg.BX = &H30π CALL Interrupt(&H10, Reg, Reg)π Reg.AX = &H3                    'set up normal text modeπ CALL Interrupt(&H10, Reg, Reg)π Reg.AX = &H1111                 'load ega character set (8 x 14)π Reg.BX = 0π CALL Interrupt(&H10, Reg, Reg)ππ 'show that we now have 28 linesπ Lines% = 28π FOR Row% = 1 TO Lines%π   LOCATE Row%, 1: PRINT USING "###"; Row%;π NEXTπ SLEEPπ 'you can increase the value of Lines in the above loop,π '   but you will see that only 28 appear on screenππ SCREEN 0: WIDTH 80, 25: CLSπ ENDπEthan Winer                    FAST LINE INPUT REPLACEMENT    FidoNet QUIK_BAS Echo          03-24-96 (01:24)       QB, QBasic, PDS        78   3248     BUFIN.BAS   '> Has anybody else been working with or using the Bufin$ routineπ'> written by Ethan Winer that was posted a few days ago as aπ'> fast substitute for the LINE INPUT command? Has anyoneπ'> else noticed that it returns an extra blank line at the endπ'> of the file unless the final line had no carriage return/lineπ'> feed at the end? Has anyone found a work-around for this bug?π'> Thanks.ππ'No, but I would love to see the code from Bufin$, then maybe I can helpπ'you out...I missed the code the first time around...! :(ππDEFINT A-ZπFUNCTION BufIn$ (FileName$, Done) STATICπ'********* BUFIN.BAS - fast LINE INPUT replacementπ'Copyright (c) 1992 Ethan WinerππIF NOT Reading THEN            'if the first time throughπ  Reading = -1                 'show that we're now readingπ  Done = 0                     'clear Done just in caseπ  CR = 0                       'no return found yet.π  CR$ = CHR$(13)               'define for speed laterππ  FileNum = FREEFILE           'open the fileπ  OPEN FileName$ FOR BINARY AS #FileNumπ  Remaining& = LOF(FileNum)    'byte count to be readππ  BufSize = 4096               'bytes to read each passπ  Buffer$ = SPACE$(BufSize)    'assume BufSize bytesπEND IFππ'---- This is the main outer loop.πDO WHILE Remaining&              'while more in the fileππ  IF CR = 0 THEN                 'if no Return was foundπ    IF Remaining& < BufSize THEN 'read only what remainsπ      BufSize = Remaining&       'resize the bufferπ      IF BufSize < 1 THEN EXIT DO'possible only if EOF 26π      Buffer$ = SPACE$(BufSize)  'create the file bufferπ    END IFπ    GET #FileNum, , Buffer$      'read a blockπ    BufPos = 1                   'start at the beginningπ  END IF                         '  of that blockππ  DO                                 'walk through bufferπ    CR = INSTR(BufPos, Buffer$, CR$) 'look for a Returnπ    IF CR THEN                       'we found oneπ      SaveCR = CR                    'save whereπ      BufIn$ = MID$(Buffer$, BufPos, CR - BufPos)π      BufPos = CR + 2                'skip inevitable LFπ      EXIT FUNCTION                  'all done for nowπ    ELSE                             'back up in the fileπ      '---- If we reached the end of the file and no 13π      '     was found, return what remains in the string.π      IF SEEK(FileNum) >= LOF(FileNum) THENπ        Output$ = MID$(Buffer$, SaveCR + 2)π        '---- Trap a trailing CHR$(26) EOF marker.π        IF RIGHT$(Output$, 1) = CHR$(26) THENπ          Output$ = LEFT$(Output$, LEN(Output$) - 1)π        END IFπ        BufIn$ = Output$             'assign the functionπ        Remaining& = BufSize         'set to fall outπ        EXIT DO                      'and exit nowπ      END IFπ      Slop = BufSize - SaveCR - 1    'calc buffer excessπ      Remaining& = Remaining& + Slop 'calc file excessπ      SEEK #FileNum, SEEK(FileNum) - Slop  'seek to startπ    END IFππ  LOOP WHILE CR                'while more in bufferπ  Remaining& = Remaining& - BufSizeππLOOPππReading = 0                    'we're not reading anymoreπDone = -1                      'show that we're all doneπCLOSE #FileNum                 'final cleanupππEND FUNCTIONπPeter Cooper                   SMOOTH VERTICAL SCROLL         comp.lang.basic.misc           04-08-96 (23:03)       QB, QBasic, PDS        46   965      SCROLLUP.BAS' There may be a small amount of flicker in some speed cases.. if you adjustπ' the delay% loop in 'upwholeline' you can eliminate this.. it is set for myπ' machine at the mo.. mail me  [e-mail]π' DONT EXIT BEFORE ITS FINISHED. your display will look strange , Peco_ππDEF SEG = &HB800ππSCREEN 0πCLSπFOR a% = 1 TO 23π        LOCATE a%π        COLOR a% MOD 15 + 1π        PRINT STRING$(80, CHR$(a% + 64))πNEXT a%ππFOR a% = 1 TO 23π        upwholelineπNEXT a%πDEF SEGπCOLOR 15ππSUB scrollupππ' you should've seen this procedure about 10 mins ago.. it was a whole scrollπ' routine using pokes etc when I realized all I had to do was this!ππLOCATE 24πPRINTππEND SUBππSUB textvert (vpos%)πOUT &H3D4, 8πOUT &H3D5, vpos%πEND SUBππSUB upwholelineπFOR a% = 0 TO 15πWAIT &H3DA, 8πtextvert a%πFOR delay% = 1 TO 8500: NEXT delay%  ' this is 8500 in PDS and 7800 in QBasic for meπNEXT a%πscrollupππtextvert 0πEND SUBπCarl Gorringe                  GET/PUT IN TEXT                FidoNet QUIK_BAS Echo          04-10-96 (11:31)       QB, QBasic, PDS        227  7796     GETPUT.BAS  '>Is it possible to wipe from one screen to another in text mode? (Looks likeπ'>one screen is raised or pulled off to the side revealing  another screenπ'>underneath.)ππ'Following is a program that will allow you to GET any portion of theπ'Text screen into an array, and then PUT it back anywhere on screen. Ifπ'the image goes off the edge, then it is simply clipped, so I believe youπ'can get the effect you are looking for by using them. Enjoy!ππ'--- Carl Gorringe --- <[e-mail]>ππ'----------------------------------π'  GETPUT.BAS - (c) Carl Gorringeπ'----------------------------------π' Released to the public domainπ' You may use this or modify it any way you want, just rememberπ'  to give me credit if you use it in your programs.ππ'---- Must Keep All of the Following! ----ππDECLARE SUB TextGetPutLoad ()πDECLARE SUB TextGetPut (Xlen%, Ylen%, SorcSeg%, SorcOff%, SorcSkip%, DestSeg%, DestOff%, DestSkip%)πDECLARE SUB TextGet (X1%, Y1%, X2%, Y2%, Image%())πDECLARE SUB TextPut (X1%, Y1%, Image%())ππCOMMON SHARED TextGetPutRoutine%()ππDIM SHARED TextGetPutRoutine%(30)πCALL TextGetPutLoadππ'--------- Begin Program ----------ππ' Put Whatever you want here.π' Just remember that the GET/PUT routines ONLY work forπ' SCREEN 0; WIDTH 80,25; and Text Page 0π' You can switch to other modes, just don't call these routines in them.ππENDπ'---------- End Program -----------ππSUB TextGet (X1%, Y1%, X2%, Y2%, Image%())ππ' ::: (c) Carl Gorringe 6/13/93 ::: << v2.1 >>π'--------------------------------------------------------π' This gets the text region from (X1%,Y1%) to (X2%,Y2%)π' and stores it in Image%(). Make sure Image%() is aπ' DYNAMIC array because this SUB will REDIM it.π' Coordinates start at (1,1) for the upper-left corner.π'--------------------------------------------------------ππScrWidth% = 80πScrLength% = 25ππIF X1% < 1 OR X1% > X2% OR Y1% < 1 OR Y1% > Y2% THEN EXIT SUBππNum% = (X2% - X1% + 1) * (Y2% - Y1% + 1) + 1πREDIM Image%(Num%)ππImage%(0) = X2% - X1% + 1πImage%(1) = Y2% - Y1% + 1ππ'<*>--------- Machine Language Varibles ----------<*>πIF X2% > ScrWidth% THENπ    TableSkip% = (X2% - ScrWidth%) * 2π    X2% = ScrWidth%πELSEπ    TableSkip% = 0πEND IFππIF Y2% > ScrLength% THENπ    Y2% = ScrLength%πEND IFππXcount% = X2% - X1% + 1: Ycount% = Y2% - Y1% + 1πScrStart% = (ScrWidth% * (Y1% - 1) + (X1% - 1)) * 2πNextLine% = (ScrWidth% * 2) - (Xcount% * 2)ππPageSegment% = &HB800    '-- Screen 0, Page 0 --πTableSegment% = VARSEG(Image%(0))πTableOffset% = VARPTR(Image%(0)) + 4ππCALL TextGetPut(Xcount%, Ycount%, PageSegment%, ScrStart%, NextLine%, TableSegment%, TableOffset%, TableSkip%)ππEND SUBππSUB TextGetPut (Xlen%, Ylen%, SorcSeg%, SorcOff%, SorcSkip%, DestSeg%, DestOff%, DestSkip%)ππ' ::: (c) Carl Gorringe 6/13/93 ::: << v1.3 >>π'--------------------------------------------------------π' This Should NOT be Used by itself!π' It should ONLY be used within TextGet() and TextPut()!π'--------------------------------------------------------ππIF TextGetPutRoutine%(0) <> &HBB06 THENπ    CALL TextGetPutLoadπEND IFππ'<*>------- Pass Machine Language Arguments -------<*>ππLow% = LBOUND(TextGetPutRoutine%)πDEF SEG = VARSEG(TextGetPutRoutine%(Low%))   '--Set Segment--πP% = VARPTR(TextGetPutRoutine%(Low%))        '--Set Offset--ππPOKE (P% + &H2), ASC(LEFT$(MKI$(SorcSeg%), 1))πPOKE (P% + &H3), ASC(RIGHT$(MKI$(SorcSeg%), 1))ππPOKE (P% + &H5), ASC(LEFT$(MKI$(DestSeg%), 1))πPOKE (P% + &H6), ASC(RIGHT$(MKI$(DestSeg%), 1))ππPOKE (P% + &H8), ASC(LEFT$(MKI$(DestOff%), 1))πPOKE (P% + &H9), ASC(RIGHT$(MKI$(DestOff%), 1))ππPOKE (P% + &HB), ASC(LEFT$(MKI$(SorcOff%), 1))πPOKE (P% + &HC), ASC(RIGHT$(MKI$(SorcOff%), 1))ππPOKE (P% + &HE), ASC(LEFT$(MKI$(Ylen%), 1))πPOKE (P% + &H10), ASC(LEFT$(MKI$(Xlen%), 1))ππPOKE (P% + &H26), ASC(LEFT$(MKI$(SorcSkip%), 1))πPOKE (P% + &H27), ASC(RIGHT$(MKI$(SorcSkip%), 1))ππPOKE (P% + &H2B), ASC(LEFT$(MKI$(DestSkip%), 1))πPOKE (P% + &H2C), ASC(RIGHT$(MKI$(DestSkip%), 1))ππ'<*>--------- Run Machine Language Routine ---------<*>ππCALL ABSOLUTE(P%)ππDEF SEGππEND SUBππSUB TextGetPutLoadππ' ::: (c) Carl Gorringe 6/13/93 ::: << v1.0 >>π'--------------------------------------------------------π' This only needs to be called once in the beginning of theπ' program to store the Assembly language code into theπ' global array TextGetPutRoutine%().π'--------------------------------------------------------ππLow% = LBOUND(TextGetPutRoutine%)πDEF SEG = VARSEG(TextGetPutRoutine%(Low%))   '--Set Segment--πP% = VARPTR(TextGetPutRoutine%(Low%))        '--Set Offset--ππ'<*>------ Start Assembly Language Code ------<*>π'         --- 41 bytes long ---ππPOKE (P% + &H0), &H6                              '  Push ESπPOKE (P% + &H1), &HBB                             '  Mov  BX , ????πPOKE (P% + &H4), &HBA                             '  Mov  DX , ????πPOKE (P% + &H7), &HBF                             '  Mov  DI , ????πPOKE (P% + &HA), &HBE                             '  Mov  SI , ????πPOKE (P% + &HD), &HB5                             '  Mov  CH , ??πPOKE (P% + &HF), &HB1                             '  Mov  CL , ??πPOKE (P% + &H11), &H8E: POKE (P% + &H12), &HC3    '  Mov  ES , BXπPOKE (P% + &H13), &H26                            ' ES:πPOKE (P% + &H14), &H8B: POKE (P% + &H15), &H4     '  Mov  AX ,[SI]πPOKE (P% + &H16), &H8E: POKE (P% + &H17), &HC2    '  Mov  ES , DXπPOKE (P% + &H18), &H26                            ' ES:πPOKE (P% + &H19), &H89: POKE (P% + &H1A), &H5     '  Mov [DI], AXπPOKE (P% + &H1B), &H83: POKE (P% + &H1C), &HC6    '  Add  SI ,+02π    POKE (P% + &H1D), &H2πPOKE (P% + &H1E), &H83: POKE (P% + &H1F), &HC7    '  Add  DI ,+02π    POKE (P% + &H20), &H2πPOKE (P% + &H21), &HFE: POKE (P% + &H22), &HC9    '  Dec  CLπPOKE (P% + &H23), &H75: POKE (P% + &H24), &HEC    '  Jnz  &H11πPOKE (P% + &H25), &HB8                            '  Mov  AX , ????πPOKE (P% + &H28), &H1: POKE (P% + &H29), &HC6     '  Add  SI , AXπPOKE (P% + &H2A), &HB8                            '  Mov  AX , ????πPOKE (P% + &H2D), &H1: POKE (P% + &H2E), &HC7     '  Add  DI , AXπPOKE (P% + &H2F), &HFE: POKE (P% + &H30), &HCD    '  Dec  CHπPOKE (P% + &H31), &H75: POKE (P% + &H32), &HDC    '  Jnz  &HFπPOKE (P% + &H33), &H7                             '  Pop  ESπPOKE (P% + &H34), &HCB                            '  Retfππ'--------------------------------πDEF SEGππEND SUBππSUB TextPut (X1%, Y1%, Image%())ππ' ::: (c) Carl Gorringe 6/13/93 ::: << v2.1 >>π'--------------------------------------------------------π' This puts the image stored in Image%() back to the screenπ' with the upper-left corner of the image at (X1%,Y1%).π' Coordinates start at (1,1) for the upper-left corner ofπ' the screen. If the image goes outside of bounds then itπ' will be automatically clipped.π'--------------------------------------------------------ππScrWidth% = 80πScrLength% = 25ππX2% = Image%(0) - 1 + X1%πY2% = Image%(1) - 1 + Y1%ππIF X1% < 1 OR X1% > X2% OR Y1% < 1 OR Y1% > Y2% THEN EXIT SUBππNum% = (X2% - X1% + 1) * (Y2% - Y1% + 1) + 1ππ'<*>--------- Machine Language Varibles ----------<*>ππIF X2% > ScrWidth% THENπ    TableSkip% = (X2% - ScrWidth%) * 2π    X2% = ScrWidth%πELSEπ    TableSkip% = 0πEND IFππIF Y2% > ScrLength% THENπ    Y2% = ScrLength%πEND IFππXcount% = X2% - X1% + 1: Ycount% = Y2% - Y1% + 1πScrStart% = (ScrWidth% * (Y1% - 1) + (X1% - 1)) * 2πNextLine% = (ScrWidth% * 2) - (Xcount% * 2)ππPageSegment% = &HB800    '-- Screen 0, Page 0 --πTableSegment% = VARSEG(Image%(0))πTableOffset% = VARPTR(Image%(0)) + 4ππCALL TextGetPut(Xcount%, Ycount%, TableSegment%, TableOffset%, TableSkip%, PageSegment%, ScrStart%, NextLine%)ππEND SUBππDouglas H. Lusher              TEXT EDITOR                    FidoNet QUIK_BAS Echo          03-11-96 (01:10)       QB, PDS                1214 35257    EDITOR.BAS  'A few comments are called for, in no particular order:π'1) this text editor works by loading a file into a string arrayπ'and allowing the user to manipulate it there. The limit on fileπ'size, then, is the amount of string memory available. In compiledπ'form, this will be about 57K. Run in the environment, this willπ'be about 40K. I have worked quite hard to prevent "Out of memory"π'errors from crashing the program, but it may not beπ'quite perfect yet. You will note a variable named "MemPad"π'at various places in the code. The program always leaves aπ'small amount of memory free for use by QB's built-in routines.π'I am working on an editor that will handle much larger fileπ'sizes, but that code is still very buggy and I will notπ'inflict my buggy code on the world.ππ'2) when compiled as-is for a stand-alone text editor, it willπ'produce about a 56K file. I am working on eliminating all useπ'of the LINE INPUT command, and when successful, the compiledπ'size should go down about 10K because the floating point emula-π'tion routines will no longer be linked in.ππ'3) please understand that I wrote this editor for my own use.π'I needed something for doing mail, small batch files, etc. Iπ'don't have very much money, so I didn't want to buy something.π'For a while I was using TED, the editor from PC magazine, butπ'I do so much of my work in QB and am so accustomed to the wayπ'the QB editor works that I found using TED to be quite annoying.π'My fingers just naturally wanted to go where they were accustommedπ'to for QB. So finally, fancying myself a moderately competentπ'programmer, I decided to write an editor for myself that workedπ'like QB's. This code is the result. I will listen to suggestionsπ'for improvement, but please understand that I will make onlyπ'such changes as suit *me*. If you want it to work differently,π'you'll have to rework the code to suit yourself. (Bug reports,π'of course, are always welcome.)ππ'4) There are, unfortunately, a dearth of comments, remarks, andπ'explanations in the code. I'm sorry. I have worked for quite aπ'while on this code and it is very familiar to me, so commentsπ'were just getting in my way. And I have done everything possibleπ'to give names to variables and procedures that make clear theirπ'purpose in the code. I fancy the code is quite readable withoutπ'many comments, but then, as I said, I'm very familiar with it,π'so I'm probably not a good judge.ππ'5) The whole trick to doing a text editor is that there are twoπ'things that you must keep track of: the location of the cursorπ'on the screen, and the location of where you are in the file.π'Variables having to do with locations on the screen are givenπ'names that contain "Row" or "Col" depending on whether theyπ'refer to a row or a column on the screen. Variables with namesπ'containing "Ln" or "Line" have to do with the lines in theπ'file (the same as the elements of the string array which containπ'the text). Variables whose names contain "Char" refer toπ'character positions in the lines of the text. CursRow%, CursCol%π'are the current location of the cursor on the screen. ActLn%π'is the line being edited. ActChar% is the character within thatπ'line where editing is taking place. Note that the active lineπ'is copied to a scalar string variable (named ActLn$) for speedπ'and ease of reference. Variable names that containπ'the letters "Ptr" are just generic pointers to lines orπ'characters. Hopefully, this information will help you to followπ'the flow of the code.π'   These variables control how much of the screen the editorπ'covers:π'  TopRow% = 1: BotRow% = 25: LeftCol% = 1: RiteCol% = 80π'these values, of course, make it take the whole screen. Simplyπ'by changing these values you can edit text on only part of theπ'screen if you wish. Note, however, that code assumes thatπ'dialog boxes can be centered in the editing area of the screen.π'If the screen window for editing is made too small, the dialogπ'boxes will be chopped off. So if you want a very small editingπ'area, you will have to rework that part of the code. As written,π'the screen window must be at least 72 columns wide and theπ'total number of screen rows should not be less than 3.π'Oh, and when you shell out to DOS, it automatically takes theπ'whole screen, so changes would have to be made there as well.ππ'6) You can load a file from the command line or from withinπ'the editor. Enter text from the keyboard. The arrow keysπ'move the cursor from line to line or character toπ'character. Home takes the cursor to the begining of theπ'current line, the End key takes it to the end.π'PageUp and PageDn move the cursor the number of lines in theπ'editing window. Control+Home takes you to the beginning of theπ'file, Control+End takes you to the end. To mark a block, holdπ'down a shift key and use the above listed keys to move the cursorπ'as desired. When a block is marked, you can delete it using theπ'delete key, or Shift+delete deletes it and moves it to theπ'clipboard. Text in the clipboard can be inserted anywhere usingπ'Shift+Insert. If a block is marked, it can be printed byπ'pressing Alt+P. A marked block can be saved to a file byπ'pressing Alt+S. When no block is marked, pressing Alt+Sπ'saves the entire file to disk. Pressing Alt+L allows you toπ'load a file into the editor. Alt+F allows you to search forπ'text in the file. Alt+R displays a ruler on the screen that youπ'can move up and down using the arrow keys. Pressing F10 willπ'shell you out to DOS. F1 is the help key, for what it's worth.π'Use Alt+X or Alt+Q to quit. Alt+X assumes you will want toπ'save the file, while Alt+Q gives you the option of exitingπ'without saving the changes you made. I forgot to mentionπ'the Tab key and the Backspace key, they both work. The insertπ'key toggles you between insert mode and overstrike mode. Whenπ'there is a dialog box on screen, you can abort and return toπ'the editor by pressing Escape.ππ'code for a text editor, written completely in QuickBASIC 4.5π'by Douglas H. Lusher, 03-11-1996πDEFINT A-Zπ'$INCLUDE: 'qb.bi'πCONST False = 0, True = NOT FalseπCONST Black = 0, Blue = 1, Brown = 6, Grey = 7πCONST AltF = -33, AltL = -38, AltP = -25, AltQ = -16πCONST AltR = -19, AltS = -31, AltX = -45πCONST ESC = 27, ENTER = 13, BkSpc = 8, TabKey = 9πCONST F1Key = -59, F10Key = -68πCONST InsertKey = -82, DeleteKey = -83πCONST HomeKey = -71, CtrlHome = -119πCONST EndKey = -79, CtrlEnd = -117πCONST PgUpKey = -73, PgDnKey = -81πCONST UpArrow = -72, DnArrow = -80, LArrow = -75, RArrow = -77ππDIM SHARED TopRow%, BotRow%, LeftCol%, RiteCol%πDIM SHARED ScrnRows%, MidRow%, ScrnWidth%πDIM SHARED FirstLn%, LastLn%, MaxLines%, FirstChar%, MaxChars%πDIM SHARED CursRow%, CursCol%, ActLn%, ActChar%πDIM SHARED FG%, BG%, BoxFG%, BoxBG%πDIM SHARED CursSize%, TabLen%, MemPad%, Null$ππTopRow% = 1: BotRow% = 25: LeftCol% = 1: RiteCol% = 80πScrnRows% = (BotRow% - TopRow%) + 1πMidRow% = TopRow% + (ScrnRows% \ 2)πScrnWidth% = (RiteCol% - LeftCol%) + 1ππFirstLn% = 1: LastLn% = 0: MaxLines% = 800πFirstChar% = 1: MaxChars% = 255ππCursRow% = TopRow%: CursCol% = LeftCol%πActLn% = FirstLn%: ActChar% = FirstChar%ππFG% = Grey: BG% = Black: BoxFG% = Grey: BoxBG% = BrownπIF ColorMonitor% THENπ  CursSize% = 12: BG% = BlueπELSEπ  CursSize% = 7πEND IFπTabLen% = 8: Null$ = "": MemPad% = 1024ππDIM Text$(FirstLn% TO MaxLines% + 1)ππ Cmd$ = RTRIM$(COMMAND$)π Ptr% = INSTR(Cmd$, "/L:")π IF Ptr% THENπ   Ptr2% = INSTR(Ptr% + 3, Cmd$, " ")π   IF Ptr2% THENπ    L$ = MID$(Cmd$, Ptr% + 3, Ptr2% - (Ptr% + 3))π    IF LEN(L$) THEN MaxLines% = VAL(L$)π    Cmd$ = MID$(Cmd$, 1, Ptr% - 1) + MID$(Cmd$, Ptr2% + 1)π   ELSEπ    L$ = MID$(Cmd$, Ptr% + 3)π    IF LEN(L$) THEN MaxLines% = VAL(L$)π    Cmd$ = RTRIM$(MID$(Cmd$, 1, Ptr% - 1))π   END IFπ END IFπ File$ = Cmd$π IF INSTR(File$, "*") OR INSTR(File$, "?") THENπ   BEEP: PRINT "No wildcards allowed in file specification": ENDπ END IFππIF LEN(File$) THENπ  IF FileExists(File$) THENπ    File = FREEFILEπ    OPEN File$ FOR INPUT AS Fileπ     IF LOF(File) THENπ       LnPtr% = 0π       DO UNTIL EOF(File)π        LnPtr% = LnPtr% + 1π        IF LnPtr% > MaxLines% THENπ          BEEP: PRINT "File has too many lines"π          CLOSE File: ENDπ        END IFπ        LINE INPUT #File, Text$(LnPtr%)π        CALL Filter(Text$(LnPtr%))π        IF FRE(Null$) < MemPad% THENπ          BEEP: PRINT "Not enough memory"π          CLOSE File: ENDπ        END IFπ       LOOPπ       LastLn% = LnPtr%π     END IFπ    CLOSE Fileπ  ELSEπ    IF NOT LegalFileName(File$) THENπ     BEEP: PRINT "Bad file name": ENDπ    END IFπ  END IFπEND IFππSCREEN 0, 1, 0: WIDTH 80πCOLOR FG%, BG%, BG%: CLSππFileChanged% = FalseπDOπCALL Edit(Text$(), ExitKey%, FileChanged%)πSELECT CASE ExitKey%π  CASE AltSπ    IF FileChanged% THENπ     IF LEN(File$) THENπ       GOSUB SaveFileπ     ELSEπ       GOSUB GetFileNameπ       IF KeyCode% = ENTER THEN GOSUB SaveFileπ     END IFπ    END IFπ  CASE AltQπ    IF FileChanged% THENπ     CALL MsgBox("Save file changes? (Y/N) ", "YyNn", KeyCode%)π     SELECT CASE KeyCode%π       CASE 89, 121                  '"Y", "y"π        IF LEN(File$) THENπ          GOSUB SaveFileπ        ELSEπ          GOSUB GetFileNameπ          IF KeyCode% = ENTER THEN GOSUB SaveFile: EXIT DOπ        END IFπ       CASE 78, 110                  '"N", "n"π        EXIT DOπ       CASE ESCπ        'do nothing to return to edit modeπ     END SELECTπ    ELSEπ     EXIT DOπ    END IFπ  CASE AltXπ    IF FileChanged% THENπ     GOSUB GetFileNameπ     IF KeyCode% = ENTER THEN GOSUB SaveFile: EXIT DOπ    ELSEπ     EXIT DOπ    END IFπEND SELECTπLOOPπCLS : ENDππGetFileName:πDOπ  CALL InputBox("File name: ", File$, KeyCode%)π  IF KeyCode% = ENTER THENπ    IF LegalFileName(File$) THEN EXIT DO ELSE BEEPπ  ELSE 'IF KeyCode% = ESC THENπ    EXIT DOπ  END IFπLOOPπRETURNππSaveFile:πFile = FREEFILEπOPEN File$ FOR OUTPUT AS Fileπ  IF LastLn% > 0 THENπ    FOR LnPtr% = FirstLn% TO LastLn%π     PRINT #File, Text$(LnPtr%)π    NEXTπ  END IFπCLOSE FileπFileChanged% = FalseπRETURNππFUNCTION ColorMonitor%πColorMonitor% = TrueπDEF SEG = 0πIF PEEK(&H463) <> &HD4 THEN ColorMonitor% = FalseπDEF SEGπEND FUNCTIONππSUB DrawBox (TopRow%, NumRows%, LCol%, NumCols%)ππTop$ = STRING$(NumCols%, "═")πMID$(Top$, 1, 2) = " ╔": MID$(Top$, NumCols% - 1, 2) = "╗ "πSide$ = SPACE$(NumCols%)πMID$(Side$, 1, 2) = " ║": MID$(Side$, NumCols% - 1, 2) = "║ "πBot$ = Top$πMID$(Bot$, 2, 1) = "╚": MID$(Bot$, NumCols% - 1, 1) = "╝"ππLOCATE TopRow%, LCol%, 0: PRINT Top$πFOR Row% = 3 TO NumRows%π  LOCATE , LCol%: PRINT Side$πNEXTπLOCATE , LCol%: PRINT Bot$;ππEND SUBππSUB Edit (Text$(), KeyCode%, FileChanged%)π'code for a text editor, written completely in QuickBASIC 4.5π'by Douglas H. Lusher, 03-11-1996ππ'when marking a block involving multiple lines:πBlkStartLn = 0        'is the starting line of the blockπBlkLines = 0          'the number of lines in the block.π                  'If zero, then not in this block marking modeππ'when marking a block of characters within a single line:πBlkStartChar = 0      'this is the starting characterπBlkChars = 0          'the number of characters in the block.π                  'If zero, then not in this block marking modeππRefresh$ = SPACE$(ScrnWidth)       'scratch spaceπInsertMode = TrueπLOCATE , , 0, CursSize - 1, CursSizeπGOSUB RefreshScreenπDOπ  ActLn$ = Text$(ActLn): ActLnLen = LEN(ActLn$)π  LOCATE CursRow, CursCol, 1π  DO WHILE LEN(INKEY$): LOOPπ  DO: Ky$ = INKEY$: LOOP UNTIL LEN(Ky$)π  DEF SEG = 0: ShiftByte = PEEK(&H417): DEF SEGπ  ShiftPressed = ((ShiftByte AND 3) <> 0)π  KeyCode = ASC(Ky$): IF KeyCode = 0 THEN KeyCode = -ASC(MID$(Ky$, 2))π  SELECT CASE KeyCodeπ    CASE 32 TO 255, 1 TO 6, 14 TO 27: GOSUB DoLetterKeyπ    CASE BkSpc: GOSUB DoBackSpaceKeyπ    CASE TabKey: GOSUB DoTabKeyπ    CASE ENTER: GOSUB DoCarriageReturnπ    CASE InsertKey: GOSUB DoInsertKeyπ    CASE DeleteKey: GOSUB DoDeleteKeyπ    CASE UpArrow: GOSUB DoUpArrowπ    CASE DnArrow: GOSUB DoDnArrowπ    CASE PgUpKey: GOSUB DoPgUpKeyπ    CASE PgDnKey: GOSUB DoPgDnKeyπ    CASE LArrow: GOSUB DoLArrowπ    CASE RArrow: GOSUB DoRArrowπ    CASE HomeKey: GOSUB DoHomeKeyπ    CASE EndKey: GOSUB DoEndKeyπ    CASE CtrlHome: GOSUB DoCtrlHomeπ    CASE CtrlEnd: GOSUB DoCtrlEndπ    CASE F1Key: GOSUB DoHelpπ    CASE F10Key: CLS : SHELL: GOSUB RefreshScreenπ    CASE AltF: GOSUB FindTextπ    CASE AltL: GOSUB LoadFileπ    CASE AltP: GOSUB DoPrintπ    CASE AltR: GOSUB DoRulerπ    CASE AltS: IF BlkLines THEN GOSUB SaveLines ELSE EXIT DOπ    CASE AltQ, AltX: EXIT DOπ    CASE ELSE: BEEPπ  END SELECTπLOOPππEXIT SUBππDoCarriageReturn:πIF BlkLines OR BlkChars THEN BEEP: RETURNπIF LastLn = MaxLines THEN BEEP: RETURNπIF ActLn < LastLn THENπ  FOR LnPtr = LastLn TO ActLn + 1 STEP -1π    SWAP Text$(LnPtr), Text$(LnPtr + 1)π  NEXTπ  Text$(ActLn) = LEFT$(ActLn$, ActChar - 1)π  Text$(ActLn + 1) = MID$(ActLn$, ActChar)πEND IFπActLn = ActLn + 1πActChar = FirstCharπIF CursRow <> BotRow THEN CursRow = CursRow + 1πCursCol = LeftColπLastLn = LastLn + 1πGOSUB RefreshScreenπFileChanged = TrueπRETURNππDoTabKey:πIF BlkLines OR BlkChars THEN BEEP: RETURNπIF ActLn > MaxLines THEN BEEP: RETURNπTabChars = TabLen - (ActChar MOD TabLen)πIF ActLnLen + TabChars > MaxChars THEN BEEP: RETURNπIF ActChar - 1 + TabChars > MaxChars THEN BEEP: RETURNπIF ActChar <= ActLnLen THENπ  Text$(ActLn) = LEFT$(ActLn$, ActChar - 1) + SPACE$(TabChars) + MID$(ActLn$, ActChar)πELSEπ  Text$(ActLn) = ActLn$ + SPACE$((ActChar - ActLnLen - 1) + TabChars)πEND IFπActChar = ActChar + TabCharsπIF CursCol + TabChars <= RiteCol THENπ  CursCol = CursCol + TabCharsπ  GOSUB RefreshLineπELSEπ  GOSUB RefreshScreenπEND IFπIF ActLn > LastLn THEN LastLn = ActLnπFileChanged = TrueπRETURNππDoDeleteKey:πIF BlkLines THENπ  IF BlkLines > 0 THENπ    ActLn = BlkStartLnπ    CursRow = Greater(CursRow - BlkLines, TopRow)π  END IFπ  ClipLines = ABS(BlkLines)π  BytesNeeded& = 0π  FOR LnPtr = ActLn TO ActLn + ClipLines - 1π    BytesNeeded& = BytesNeeded& + LEN(Text$(LnPtr)) + 6π  NEXTπ  IF BytesNeeded& + MemPad > FRE(Null$) THEN ClipLines = 0: BEEP: RETURNπ  REDIM ClipBoard$(ClipLines - 1)π  FOR LnPtr = 0 TO ClipLines - 1π    SWAP ClipBoard$(LnPtr), Text$(ActLn + LnPtr)π  NEXTπ  FOR LnPtr = ActLn TO LastLn - ClipLinesπ    SWAP Text$(LnPtr), Text$(LnPtr + ClipLines)π  NEXTπ  BlkLines = 0: ClipChars = 0π  LastLn = LastLn - ClipLinesπ  IF NOT ShiftPressed THEN ClipLines = 0: ERASE ClipBoard$π  GOSUB RefreshScreenπELSEIF BlkChars THENπ  IF BlkChars > 0 THENπ    ActChar = BlkStartCharπ    CursCol = Greater(CursCol - BlkChars, LeftCol)π  END IFπ  ClipChars = ABS(BlkChars)π  ClipBoard$ = MID$(ActLn$, ActChar, ClipChars)π  Text$(ActLn) = LEFT$(ActLn$, ActChar - 1) + MID$(ActLn$, ActChar + ClipChars)π  BlkChars = 0: ClipLines = 0π  IF NOT ShiftPressed THEN ClipChars = 0: ClipBoard$ = Null$π  GOSUB RefreshScreenπELSE 'no blocks markedπ  IF ShiftPressed THEN BEEP: RETURNπ  IF ActChar <= ActLnLen THENπ    Text$(ActLn) = LEFT$(ActLn$, ActChar - 1) + MID$(ActLn$, ActChar + 1)π    GOSUB RefreshLineπ  ELSE 'IF ActChar > ActLnLen THENπ    IF ActLn >= LastLn THEN BEEP: RETURNπ    IF ActChar > MaxChars THEN BEEP: RETURNπ    IF (ActChar - 1) + LEN(Text$(ActLn + 1)) > MaxChars THEN BEEP: RETURNπ    Text$(ActLn) = ActLn$ + SPACE$(ActChar - ActLnLen - 1) + Text$(ActLn + 1)π    Text$(ActLn + 1) = Null$π    FOR LnPtr = ActLn + 1 TO LastLnπ     SWAP Text$(LnPtr), Text$(LnPtr + 1)π    NEXTπ    LastLn = LastLn - 1π    GOSUB RefreshScreenπ  END IFπEND IFπFileChanged = TrueπRETURNππDoInsertKey:πIF ShiftPressed THENπ  IF ClipLines THENπ    IF LastLn + ClipLines > MaxLines THEN BEEP: RETURNπ    BytesNeeded& = 0π    FOR LnPtr = 0 TO ClipLines - 1π     BytesNeeded& = BytesNeeded& + LEN(ClipBoard$(LnPtr))π    NEXTπ    IF BytesNeeded& + MemPad > FRE(Null$) THEN BEEP: RETURNπ    IF ActLn <= LastLn THENπ     FOR LnPtr = LastLn TO ActLn STEP -1π       SWAP Text$(LnPtr), Text$(LnPtr + ClipLines)π     NEXTπ    END IFπ    FOR LnPtr = 0 TO ClipLines - 1π     Text$(ActLn + LnPtr) = ClipBoard$(LnPtr)π    NEXTπ    LastLn = LastLn + ClipLinesπ    GOSUB RefreshScreenπ    FileChanged = Trueπ  ELSEIF ClipChars THENπ    IF ActLn > MaxLines THEN BEEP: RETURNπ    IF ActLnLen + ClipChars > MaxChars THEN BEEP: RETURNπ    IF ActChar + ClipChars - 1 > MaxChars THEN BEEP: RETURNπ    IF ActChar <= ActLnLen THENπ     Text$(ActLn) = LEFT$(ActLn$, ActChar - 1) + ClipBoard$ + MID$(ActLn$, ActChar)π    ELSEπ     Text$(ActLn) = ActLn$ + SPACE$(ActChar - ActLnLen - 1) + ClipBoard$π    END IFπ    IF ActLn > LastLn THEN LastLn = ActLnπ    GOSUB RefreshLineπ    FileChanged = Trueπ  END IFπELSE 'IF NOT ShiftPressed THENπ  InsertMode = NOT InsertModeπ  IF InsertMode THENπ    LOCATE , , , CursSize - 1, CursSizeπ  ELSEπ    LOCATE , , , CursSize \ 2, CursSizeπ  END IFπEND IFπRETURNππDoBackSpaceKey:πIF BlkLines OR BlkChars THEN BEEP: RETURNπIF ActChar = FirstChar THENπ  IF ActLn = FirstLn THEN BEEP: RETURNπ  IF ActLnLen + LEN(Text$(ActLn - 1)) > MaxChars THEN BEEP: RETURNπ  ActChar = LEN(Text$(ActLn - 1)) + 1π  Text$(ActLn - 1) = Text$(ActLn - 1) + ActLn$π  Text$(ActLn) = Null$π  FOR LnPtr = ActLn TO LastLnπ    SWAP Text$(LnPtr), Text$(LnPtr + 1)π  NEXTπ  IF LastLn >= ActLn THEN LastLn = LastLn - 1π  ActLn = ActLn - 1π  IF CursRow <> TopRow THEN CursRow = CursRow - 1π  CursCol = Lesser(ActChar, RiteCol)π  GOSUB RefreshScreenπELSE 'IF ActChar > FirstChar THENπ  IF ActChar <= ActLnLen + 1 THENπ    Text$(ActLn) = LEFT$(ActLn$, ActChar - 2) + MID$(ActLn$, ActChar)π  END IFπ  ActChar = ActChar - 1π  IF CursCol <> LeftCol THENπ    CursCol = CursCol - 1π    GOSUB RefreshLineπ  ELSEπ    GOSUB RefreshScreenπ  END IFπEND IFπFileChanged = TrueπRETURNππDoLetterKey:πIF BlkLines OR BlkChars THEN BEEP: RETURNπIF ActLn > MaxLines THEN BEEP: RETURNπIF ActChar > MaxChars THEN BEEP: RETURNπIF ActChar <= ActLnLen THENπ  IF InsertMode THENπ    IF ActLnLen = MaxChars THEN BEEP: RETURNπ    Text$(ActLn) = LEFT$(ActLn$, ActChar - 1) + " " + MID$(ActLn$, ActChar)π  END IFπ  MID$(Text$(ActLn), ActChar) = Ky$πELSE 'IF ActChar > ActLnLen THENπ  Text$(ActLn) = ActLn$ + SPACE$(ActChar - ActLnLen - 1) + Ky$πEND IFπActChar = ActChar + 1πIF CursCol <> RiteCol THENπ  CursCol = CursCol + 1π  GOSUB RefreshLineπELSEπ  GOSUB RefreshScreenπEND IFπIF ActLn > LastLn THEN LastLn = ActLnπFileChanged = TrueπRETURNππDoUpArrow:πBlkChars = 0πIF ShiftPressed THENπ  IF BlkLines = 0 THEN BlkStartLn = ActLnπ  IF ActLn > FirstLn THEN BlkLines = BlkLines - 1πELSEπ  BlkLines = 0πEND IFπIF ActLn <> FirstLn THENπ  ActLn = ActLn - 1π  IF CursRow <> TopRow THEN CursRow = CursRow - 1πEND IFπGOSUB RefreshScreenπRETURNππDoDnArrow:πBlkChars = 0πIF ShiftPressed THENπ  IF BlkLines = 0 THEN BlkStartLn = ActLnπ  IF ActLn <= LastLn THEN BlkLines = BlkLines + 1πELSEπ  BlkLines = 0πEND IFπIF ActLn <= LastLn THENπ  ActLn = ActLn + 1π  IF CursRow <> BotRow THEN CursRow = CursRow + 1πEND IFπGOSUB RefreshScreenπRETURNππDoPgUpKey:πBlkChars = 0πIF ShiftPressed THENπ  IF BlkLines = 0 THEN BlkStartLn = ActLnπ  BlkLines = Greater(BlkLines - ScrnRows, FirstLn - BlkStartLn)πELSEπ  BlkLines = 0πEND IFπActLn = Greater(ActLn - ScrnRows, FirstLn)πIF ActLn < CursRow THEN CursRow = TopRow + ActLn - 1πGOSUB RefreshScreenπRETURNππDoPgDnKey:πBlkChars = 0πIF ShiftPressed THENπ  IF BlkLines = 0 THEN BlkStartLn = ActLnπ  BlkLines = Lesser(BlkLines + ScrnRows, (LastLn + 1) - BlkStartLn)πELSEπ  BlkLines = 0πEND IFπActLn = Lesser(ActLn + ScrnRows, LastLn + 1)πIF (LastLn + 1) - ActLn < BotRow - CursRow THENπ  CursRow = Lesser(BotRow - ((LastLn + 1) - ActLn), TopRow + LastLn)πEND IFπGOSUB RefreshScreenπRETURNππDoLArrow:πIF ShiftPressed THENπ  IF BlkLines THEN BEEP: RETURNπ  IF BlkChars = 0 THEN BlkStartChar = ActCharπ  BlkChars = Greater(BlkChars - 1, FirstChar - BlkStartChar)πELSEπ  BlkLines = 0: BlkChars = 0πEND IFπIF ActChar <> FirstChar THENπ  ActChar = ActChar - 1π  IF CursCol <> LeftCol THEN CursCol = CursCol - 1πEND IFπGOSUB RefreshScreenπRETURNππDoRArrow:πIF ShiftPressed THENπ  IF BlkLines THEN BEEP: RETURNπ  IF BlkChars = 0 THEN BlkStartChar = ActCharπ  IF ActChar <= MaxChars THEN BlkChars = BlkChars + 1πELSEπ  BlkLines = 0: BlkChars = 0πEND IFπIF ActChar <= MaxChars THENπ  ActChar = ActChar + 1π  IF CursCol <> RiteCol THEN CursCol = CursCol + 1πEND IFπGOSUB RefreshScreenπRETURNππDoHomeKey:πIF ShiftPressed THENπ  IF BlkLines THEN BEEP: RETURNπ  IF BlkChars = 0 THEN BlkStartChar = ActCharπ  BlkChars = FirstChar - BlkStartCharπELSEπ  BlkLines = 0: BlkChars = 0πEND IFπActChar = FirstCharπCursCol = LeftColπGOSUB RefreshScreenπRETURNππDoEndKey:πIF ShiftPressed THENπ  IF BlkLines THEN BEEP: RETURNπ  IF BlkChars = 0 THEN BlkStartChar = ActCharπ  BlkChars = (ActLnLen + 1) - BlkStartCharπELSEπ  BlkLines = 0: BlkChars = 0πEND IFπLeftChar = ActChar - CursCol + 1πActChar = ActLnLen + 1πIF ActChar <= LeftChar THENπ  CursCol = Lesser(ActChar, RiteCol)πELSEπ  CursCol = Lesser(ActChar - LeftChar + 1, RiteCol)πEND IFπGOSUB RefreshScreenπRETURNππDoCtrlHome:πBlkChars = 0πIF ShiftPressed THENπ  IF BlkLines = 0 THEN BlkStartLn = ActLnπ  BlkLines = FirstLn - BlkStartLnπELSEπ  BlkLines = 0πEND IFπActLn = FirstLnπCursRow = TopRowπGOSUB RefreshScreenπRETURNππDoCtrlEnd:πBlkChars = 0πIF ShiftPressed THENπ  IF BlkLines = 0 THEN BlkStartLn = ActLnπ  BlkLines = (LastLn + 1) - BlkStartLnπELSEπ  BlkLines = 0πEND IFπActLn = LastLn + 1πCursRow = Lesser(BotRow, TopRow + LastLn)πGOSUB RefreshScreenπRETURNππRefreshScreen:πLOCATE , , 0πLnPtr = ActLn - (CursRow - TopRow)πCharPtr = ActChar - (CursCol - LeftCol)πIF BlkLines THENπ  StartLn = BlkStartLn: StopLn = BlkStartLn + BlkLinesπ  IF StartLn > StopLn THEN SWAP StartLn, StopLnπ  FOR Row = TopRow TO BotRowπ    LSET Refresh$ = MID$(Text$(LnPtr), CharPtr, ScrnWidth)π    LOCATE Row, LeftColπ    IF LnPtr >= StartLn AND LnPtr < StopLn THENπ     COLOR BG, FG: PRINT Refresh$; : COLOR FG, BGπ    ELSEπ     PRINT Refresh$;π    END IFπ    LnPtr = LnPtr + 1π  NEXTπELSEIF BlkChars THENπ  StartChar = BlkStartChar: StopChar = BlkStartChar + BlkCharsπ  IF StartChar > StopChar THEN SWAP StartChar, StopCharπ  LCol = Greater(StartChar - CharPtr, 0)π  RCol = StopChar - CharPtrπ  FOR Row = TopRow TO BotRowπ    LSET Refresh$ = MID$(Text$(LnPtr), CharPtr, ScrnWidth)π    LOCATE Row, LeftColπ    IF LnPtr = ActLn THENπ     PRINT LEFT$(Refresh$, LCol);π     COLOR BG, FGπ     PRINT MID$(Refresh$, LCol + 1, RCol - LCol);π     COLOR FG, BGπ     PRINT MID$(Refresh$, RCol + 1);π    ELSEπ     PRINT Refresh$;π    END IFπ    LnPtr = LnPtr + 1π  NEXTπELSEπ  FOR Row = TopRow TO BotRowπ    LSET Refresh$ = MID$(Text$(LnPtr), CharPtr, ScrnWidth)π    LOCATE Row, LeftColπ    PRINT Refresh$;π    LnPtr = LnPtr + 1π  NEXTπEND IFπRETURNππRefreshLine:πLSET Refresh$ = MID$(Text$(ActLn), ActChar - CursCol + LeftCol, ScrnWidth)πLOCATE CursRow, LeftCol, 0πIF BlkChars THENπ  StartChar = BlkStartChar: StopChar = BlkStartChar + BlkCharsπ  IF StartChar > StopChar THEN SWAP StartChar, StopCharπ  LCol = Greater(StartChar - CharPtr, 0)π  RCol = StopChar - CharPtrπ  PRINT LEFT$(Refresh$, LCol);π  COLOR BG, FGπ  PRINT MID$(Refresh$, LCol + 1, RCol - LCol);π  COLOR FG, BGπ  PRINT MID$(Refresh$, RCol + 1);πELSEπ  PRINT Refresh$;πEND IFπRETURNππDoHelp:πTemp$ = STR$(ActChar): MID$(Temp$, 1, 1) = ":"πMsg$ = "Cursor" + STR$(ActLn) + Temp$ + " | Bytes free:" + STR$(FRE(Null$))πD = (ScrnWidth - LEN(Msg$)) \ 2 - 4πCOLOR BoxFG, BoxBGπCALL DrawBox(MidRow% - 1, 3, LeftCol + D, LEN(Msg$) + 8)πLOCATE MidRow%, LeftCol + D + 4: PRINT Msg$;πDO UNTIL ASC(INPUT$(1)) = ESC: LOOPπTemp$ = Null$: Msg$ = Null$πCOLOR FG, BGπGOSUB RefreshScreenπRETURNππLoadFile:πIF BlkLines OR BlkChars THEN BEEP: RETURNπIF ActLn > MaxLines THEN BEEP: RETURNπCALL InputBox("File name: ", LoadFile$, KeyCode)πGOSUB RefreshScreenπIF KeyCode <> ENTER THEN RETURNπLoadFile$ = LTRIM$(RTRIM$(LoadFile$))πIF LEN(LoadFile$) = 0 THEN RETURNπIF FileExists(LoadFile$) THENπ  FileLines = FileLineCount(LoadFile$)π  IF FileLines = 0 THEN RETURNπ  IF LastLn + FileLines > MaxLines THENπ    CALL MsgBox("File has too many lines", Null$, KeyCode)π    GOSUB RefreshScreen: RETURNπ  ELSEIF FileSize&(LoadFile$) + MemPad > FRE(Null$) THENπ    CALL MsgBox("Not enough memory", Null$, KeyCode)π    GOSUB RefreshScreen: RETURNπ  END IFπELSEπ  BEEP: CALL MsgBox("File not found", Null$, KeyCode)π  GOSUB RefreshScreen: GOTO LoadFileπEND IFππIF ActLn <= LastLn THENπ  FOR LnPtr = LastLn TO ActLn STEP -1π    SWAP Text$(LnPtr), Text$(LnPtr + FileLines)π  NEXTπEND IFπFile = FREEFILEπOPEN LoadFile$ FOR INPUT AS #Fileπ  FOR LnPtr = ActLn TO ActLn + FileLines - 1π    LINE INPUT #File, FileLn$π    CALL Filter(FileLn$)π    Text$(LnPtr) = FileLn$π  NEXTπ  FileLn$ = Null$πCLOSE FileπLastLn = LastLn + FileLinesπFileChanged = TrueπGOSUB RefreshScreenπRETURNππSaveLines:πCALL InputBox("File name: ", SaveFile$, KeyCode)πGOSUB RefreshScreenπIF KeyCode = ENTER THENπ  SaveFile$ = LTRIM$(RTRIM$(SaveFile$))π  IF LEN(SaveFile$) THENπ    IF FileExists(SaveFile$) THENπ     CALL MsgBox("Specified file already exists: [A]ppend [O]verwrite [C]ancel? ", "AaOoCc", KeyCode)π     GOSUB RefreshScreenπ     SELECT CASE KeyCodeπ       CASE 65, 97: Mode$ = "A": GOSUB DoFileSaveπ       CASE 79, 111: Mode$ = "O": GOSUB DoFileSaveπ       CASE 67, 99, ESC    'do nothing to cancel the saveπ     END SELECTπ    ELSEπ     IF LegalFileName(SaveFile$) THENπ       Mode$ = "O": GOSUB DoFileSaveπ     ELSEπ       CALL MsgBox("Bad file name", Null$, KeyCode)π       GOSUB RefreshScreen: GOTO SaveLinesπ     END IFπ    END IFπ  END IFπEND IFπRETURNππDoFileSave:πFile = FREEFILEπOPEN Mode$, File, SaveFile$π  StartLn = Lesser(ActLn, BlkStartLn)π  FOR LnPtr = StartLn TO StartLn + ABS(BlkLines) - 1π    PRINT #File, Text$(LnPtr)π  NEXTπCLOSE FileπRETURNππFindText:πIF BlkLines THEN BEEP: RETURNπIF BlkChars THENπ  CharPtr = Lesser(BlkStartChar, BlkStartChar + BlkChars)π  Search$ = MID$(ActLn$, CharPtr, ABS(BlkChars))π  GOSUB SearchπELSEπ  CALL InputBox("Find: ", Search$, KeyCode)π  GOSUB RefreshScreenπ  IF KeyCode = ENTER THENπ    IF LEN(Search$) THEN GOSUB Searchπ  END IFπEND IFπRETURNππSearch:πCount = 0πLnPtr = ActLn: CharPtr = ActCharπDOπ  CharPtr = INSTR(CharPtr, Text$(LnPtr), Search$)π  IF CharPtr THENπ    BlkStartChar = CharPtrπ    BlkChars = LEN(Search$)π    ActChar = BlkStartChar + BlkCharsπ    CursCol = Lesser(LeftCol + ActChar - 1, RiteCol)π    TopLn = ActLn - (CursRow - TopRow)π    ActLn = LnPtrπ    CursRow = MidRowπ    IF ActLn >= TopLn AND ActLn < TopLn + ScrnRows THENπ     CursRow = TopRow + (ActLn - TopLn)π    ELSEIF ActLn <= ScrnRows THENπ     CursRow = TopRow + ActLn - 1π    ELSEIF (LastLn + 1) - ActLn < BotRow - CursRow THENπ     CursRow = BotRow - ((LastLn + 1) - ActLn)π    END IFπ    GOSUB RefreshScreen: EXIT DOπ  ELSEπ    Count = Count + 1π    IF Count > LastLn THENπ     CALL MsgBox("Search string not found", Null$, KeyCode)π     GOSUB RefreshScreen: EXIT DOπ    END IFπ    LnPtr = LnPtr + 1: IF LnPtr > LastLn THEN LnPtr = FirstLnπ    CharPtr = 1π  END IFπLOOPπRETURNππDoPrint:πIF BlkLines THENπ  StartLn = Lesser(ActLn, BlkStartLn)π  StopLn = StartLn + ABS(BlkLines) - 1πELSEπ  StartLn = FirstLnπ  StopLn = LastLnπEND IFπFOR LnPtr = StartLn TO StopLnπ  LPRINT Text$(LnPtr)πNEXTπBlkLines = 0πGOSUB RefreshScreenπRETURNππDoRuler:πIF BlkLines OR BlkChars THEN RETURNπRuler$ = SPACE$(MaxChars)πFOR CharPtr = 1 TO MaxCharsπ  MID$(Ruler$, CharPtr, 1) = "┬"π  IF CharPtr MOD 5 = 0 THEN MID$(Ruler$, CharPtr) = "┼"π  IF CharPtr MOD 10 = 0 THENπ    MID$(Ruler$, CharPtr - 1) = CHR$(((CharPtr \ 10) MOD 10) + 48)π  END IFπNEXTπRuler$ = MID$(Ruler$, ActChar - CursCol + LeftCol, ScrnWidth)ππRulerRow = TopRowπDOπ  GOSUB PrintRulerπ  DO WHILE LEN(INKEY$): LOOPπ  DO: Ky$ = INKEY$: LOOP UNTIL LEN(Ky$)π  KeyCode = ASC(Ky$): IF KeyCode = 0 THEN KeyCode = -ASC(MID$(Ky$, 2))πSELECT CASE KeyCodeπ    CASE UpArrowπ     IF RulerRow > TopRow THEN RulerRow = RulerRow - 1π    CASE DnArrowπ     IF RulerRow < BotRow THEN RulerRow = RulerRow + 1π    CASE PgUpKeyπ     IF RulerRow <> TopRow THEN RulerRow = TopRowπ    CASE PgDnKeyπ     IF RulerRow <> BotRow THEN RulerRow = BotRowπ    CASE ESCπ     EXIT DOπ    CASE ELSEπ     BEEPπ  END SELECTπLOOPπRuler$ = Null$πGOSUB RefreshScreenπRETURNππPrintRuler:πGOSUB RefreshScreenπLOCATE RulerRow, LeftCol, 0πCOLOR BG, FG: PRINT Ruler$; : COLOR FG, BGπRETURNππEND SUBππFUNCTION FileExists% (FileName$)πDIM XRegister AS RegTypeXππ'save the current DTAπXRegister.AX = &H2F00πCALL InterruptX(&H21, XRegister, XRegister)πOldDTASeg% = XRegister.ESπOldDTAOff% = XRegister.BXππ'set up a new DTAπDTA$ = SPACE$(43)πXRegister.AX = &H1A00πXRegister.DS = VARSEG(DTA$)πXRegister.DX = SADD(DTA$)πCALL InterruptX(&H21, XRegister, XRegister)ππ'get first matching fileπTemp$ = FileName$ + CHR$(0)πXRegister.AX = &H4E00πXRegister.CX = &H6πXRegister.DS = VARSEG(Temp$)πXRegister.DX = SADD(Temp$)πCALL InterruptX(&H21, XRegister, XRegister)π'if the carry flag is clear then the file existsπFileExists% = ((XRegister.Flags AND 1) = 0)π'restore the old DTAπXRegister.AX = &H1A00πXRegister.DS = OldDTASeg%πXRegister.DX = OldDTAOff%πCALL InterruptX(&H21, XRegister, XRegister)ππEND FUNCTIONππFUNCTION FileLineCount% (FileName$)πlines% = 0πFile = FREEFILEπOPEN FileName$ FOR INPUT AS Fileπ  DO UNTIL EOF(File)π    lines% = lines% + 1π    LINE INPUT #File, FileLine$π  LOOPπCLOSE FileπFileLineCount% = lines%πEND FUNCTIONππFUNCTION FileSize& (FileName$)πFile = FREEFILEπOPEN FileName$ FOR BINARY AS Fileπ  FileSize& = LOF(File)πCLOSE FileπEND FUNCTIONππSUB Filter (Dirty$)ππChar$ = CHR$(7): GOSUB FilterIt       'beepπBadChr$ = CHR$(12): GOSUB FilterIt    'Form feedππBadChr$ = CHR$(9)                     'tabπPtr% = 1πDOπ  Ptr% = INSTR(Ptr%, Dirty$, BadChr$)π  IF Ptr% THENπ    TabChars% = TabLen - (Ptr% MOD TabLen%)π    Dirty$ = MID$(Dirty$, 1, Ptr% - 1) + SPACE$(TabChars%) + MID$(Dirty$, Ptr% + 1)π  ELSEπ    EXIT DOπ  END IFπLOOPπDirty$ = LEFT$(Dirty$, MaxChars%)πEXIT SUBππFilterIt:πPtr% = 1πDOπ  Ptr% = INSTR(Ptr%, Dirty$, Char$)π  IF Ptr% THENπ    MID$(Dirty$, Ptr%, 1) = " "π  ELSEπ    EXIT DOπ  END IFπLOOPπRETURNππEND SUBππFUNCTION Greater% (Var1%, Var2%) STATICπGreater% = Var1%: IF Var2% > Var1% THEN Greater% = Var2%πEND FUNCTIONππSUB InputBox (Prompt$, InputText$, KeyCode%)ππCOLOR BoxFG%, BoxBG%πCALL DrawBox(MidRow% - 1, 3, LeftCol% + 3, ScrnWidth% - 6)πDOπ  LOCATE MidRow%, LeftCol% + 7: PRINT Prompt$;π  CALL InputLine(InputText$, ScrnWidth% - 15 - LEN(Prompt$), KeyCode%)πLOOP UNTIL KeyCode% = ENTER OR KeyCode% = ESCπCOLOR FG%, BG%ππEND SUBππSUB InputLine (Text$, ViewWidth%, KeyCode%)ππMaxLnLen% = 128πLCol% = POS(0): RCol% = LCol% + ViewWidth% - 1πView$ = SPACE$(ViewWidth%)πWork$ = LEFT$(Text$, MaxLnLen%)πLnLen% = LEN(Work$)πCCol% = Lesser(LCol% + LnLen%, RCol%)πAChar% = LnLen% + 1ππLOCATE , , 0, CursSize% - 1, CursSize%πInsert% = TrueπDOπ  LOCATE , LCol%π  LSET View$ = MID$(Work$, AChar% - (CCol% - LCol%), ViewWidth%)π  PRINT View$;π  LOCATE , CCol%, 1π  LnLen% = LEN(Work$)π  DOπ    DO: Ky$ = INKEY$: LOOP UNTIL LEN(Ky$)π    KeyCode% = ASC(Ky$): IF KeyCode% = 0 THEN KeyCode% = -ASC(MID$(Ky$, 2))π  LOOP UNTIL KeyCode% <> BadKey%: BadKey% = 0π  LOCATE , , 0π  SELECT CASE KeyCode%π    CASE BkSpcπ     IF AChar% = 1 THENπ       BEEP: BadKey% = KeyCode%π     ELSEπ       IF AChar% <= LnLen% + 1 THENπ        Work$ = LEFT$(Work$, AChar% - 2) + MID$(Work$, AChar%)π       END IFπ       AChar% = AChar% - 1π       IF CCol% <> LCol% THEN CCol% = CCol% - 1π     END IFπ    CASE ENTERπ     Text$ = Work$π     EXIT DOπ    CASE ESCπ     EXIT DOπ    CASE 32 TO 255      ' letter keysπ     IF AChar% > MaxLnLen% THENπ       BEEP: BadKey% = KeyCode%π     ELSEπ       IF AChar% <= LnLen% THENπ        IF Insert% THENπ          IF LnLen% = MaxLnLen% THENπ            BEEP: BadKey% = KeyCode%π          ELSEπ            Work$ = LEFT$(Work$, AChar% - 1) + Ky$ + MID$(Work$, AChar%)π            AChar% = AChar% + 1π            IF CCol% <> RCol% THEN CCol% = CCol% + 1π          END IFπ        ELSE 'IF NOT Insert% THEN (in overstrike mode)π          MID$(Work$, AChar%, 1) = Ky$π          AChar% = AChar% + 1π          IF CCol% <> RCol% THEN CCol% = CCol% + 1π        END IFπ       ELSE 'IF AChar% > LnLen% THENπ        Work$ = Work$ + SPACE$(AChar% - LnLen% - 1) + Ky$π        AChar% = AChar% + 1π        IF CCol% <> RCol% THEN CCol% = CCol% + 1π       END IFπ     END IFπ    CASE LArrowπ     IF AChar% = 1 THENπ       BEEP: BadKey% = KeyCode%π     ELSE 'IF AChar% > 1 THENπ       AChar% = AChar% - 1π       IF CCol% <> LCol% THEN CCol% = CCol% - 1π     END IFπ    CASE RArrowπ     IF AChar% > MaxLnLen% THENπ       BEEP: BadKey% = KeyCode%π     ELSEπ       AChar% = AChar% + 1π       IF CCol% <> RCol% THEN CCol% = CCol% + 1π     END IFπ    CASE HomeKeyπ     AChar% = 1π     CCol% = LCol%π    CASE EndKeyπ     AChar% = LnLen% + 1π     CCol% = Lesser(LCol% + LnLen%, RCol%)π    CASE InsertKeyπ     Insert% = NOT Insert%π     IF Insert% THENπ       LOCATE , , , CursSize% - 1, CursSize%π     ELSEπ       LOCATE , , , CursSize% \ 2, CursSize%π     END IFπ    CASE DeleteKeyπ     IF AChar% <= LnLen% THENπ       Work$ = LEFT$(Work$, AChar% - 1) + MID$(Work$, AChar% + 1)π     END IFπ    CASE ELSEπ     BEEP: BadKey% = KeyCode%π  END SELECTπ LOOPπ LOCATE , , , CursSize% - 1, CursSize%ππEND SUBππ FUNCTION LegalFileName% (FileName$)π DIM XRegister AS RegTypeXπ LegalFileName% = Falseπ IF FileExists%(FileName$) THENπ  LegalFileName% = Trueπ ELSEπ  'attempt to create the fileπ  Temp$ = FileName$ + CHR$(0)π  XRegister.AX = &H3C00π  XRegister.CX = 0π  XRegister.DS = VARSEG(Temp$)π  XRegister.DX = SADD(Temp$)π  CALL InterruptX(&H21, XRegister, XRegister)π  IF (XRegister.Flags AND 1) = 0 THENπ    'if carry flag is clear, then file was created OKπ    LegalFileName% = Trueπ    'delete the fileπ    XRegister.AX = &H4100π    CALL InterruptX(&H21, XRegister, XRegister)π  END IFπ END IFππ END FUNCTIONππ FUNCTION Lesser% (Var1%, Var2%) STATICπ Lesser% = Var1%: IF Var2% < Var1% THEN Lesser% = Var2%π END FUNCTIONππSUB MsgBox (Msg$, ValidKeys$, KeyCode%)ππ W% = LEN(Msg$) + 8π M% = ScrnWidth% - 6π IF W% > M% THEN W% = M% - 4π D% = (ScrnWidth% - W%) \ 2π COLOR BoxFG%, BoxBG%π CALL DrawBox(MidRow% - 1, 3, LeftCol% + D%, ScrnWidth% - (D% * 2))π LOCATE MidRow%, LeftCol% + D% + 4: PRINT LEFT$(Msg$, W%);π COLOR FG%, BG%ππ DO WHILE LEN(INKEY$): LOOPπ IF LEN(ValidKeys$) THENπ  LOCATE , , 1π  DOπ    DO: VK$ = INKEY$: LOOP UNTIL LEN(VK$)π    IF ASC(VK$) = ESC THEN EXIT DOπ    IF INSTR(ValidKeys$, VK$) THEN EXIT DO ELSE BEEPπ  LOOPπ  LOCATE , , 0π  KeyCode% = ASC(VK$)π ELSEπ  DO UNTIL LEN(INKEY$): LOOPπ END IFπEND SUBππSUB SetVGABorderColor (Colour%)π 'Colour must be in the range 0 - 255π DIM Register AS RegTypeπ Register.AX = &H1001π Register.BX = Colour% * &H100π CALL Interrupt(&H10, Register, Register)πEND SUBππNaushir Patuck                 STRING EDIT/INPUT ROUTINE      [e-mail]           04-21-96 (21:25)       QB, QBasic, PDS        250  6532     INPUT.BAS   'This is a useful string Editing/Input routine I wroteπ'to get rid of the horrors of Input forever :-)ππDECLARE SUB enter (text$, min!, max!, permitted$, caps!, justify!, password!, insert!, cursorvisible!, fillchar$)ππCLSπLOCATE 1, 4πPRINT "Name : [" + STRING$(20, " ") + "]";πLOCATE , 12ππ'Text to be edited.  If left as "", a new string will be createdπtext$ = "Jack"ππ'Minimum number of charactersπmin = 2ππ'Maximum number of charactersπmax = 20ππ'All the characters which areπ'allowed to be enteredπ'NOTE : Space should also be included here (if needed).πpermitted$ = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz "ππ'Set case of text$π'0 = As is enteredπ'1 = All characters changed are upper caseπcaps = 0ππ'Justification of text$π'0 = Noneπ'1 = Left Justifyπ'2 = Right Justifyπjustify = 0ππ'Set password type displayπ'0 = Offπ'1 = Onπpassword = 0ππ'Set insert stateπ'0 = Offπ'1 = Onπ'Note : Insert can be toggled on and off with theπ'       INSERT Key when the subroutine is runningπinsert = 1ππ'Is cursor visible or notπ'0 = Noπ'1 = Yesπcursorvisible = 1ππ'This fills the rest of the string (the empty part)π'with the character provided by fillchar$ during display.π'NOTE : This is just for the display of the string on the screenπ'       and will not actually be added text$πfillchar$ = "∙"ππ'Calling routineπenter text$, min, max, permitted$, caps, justify, password, insert, cursorvisible, fillchar$ππLOCATE 3, 4πPRINT "The Name you entered was '" + text$ + "'"πLOCATE 4, 4πPRINT "Length of string :"; LEN(text$)π                π'Pls send comments/suggestions to :π'Naushir Patuckπ'[e-mail]ππSUB enter (text$, min, max, permitted$, caps, justify, password, insert, cursorvisible, fillchar$)ππoldxpos = POS(0)πoldypos = CSRLINπcursorposn = LEN(text$) + 1πended = 0πxpos = oldxposπypos = oldyposππIF caps THEN text$ = UCASE$(text$)ππIF cursorvisible = 1 THENπ  IF insert = 1 THENπ    LOCATE ypos, xpos, 1, 7, 7π  ELSEπ    LOCATE ypos, xpos, 1, 0, 7π  END IFπELSEπ  cursorvisible = 0πEND IFππIF password = 1 THENπ  PRINT STRING$(LEN(text$), 254) + (STRING$(max - LEN(text$), fillchar$))πELSEπ  PRINT text$ + STRING$(max - LEN(text$), fillchar$)πEND IFππxpos = xpos + LEN(text$)πoldtext$ = text$ππDOπ  π  LOCATE ypos, xpos, cursorvisibleπ  π  x$ = ""π  WHILE LEN(x$) = 0π    x$ = INKEY$π  WENDπ  π  SELECT CASE x$π      π    CASE CHR$(27)                                 ' ESC Keyπ      IF oldtext$ <> "" THENπ        text$ = oldtext$π        cursorposn = LEN(text$) + 1π        xpos = oldxpos + LEN(text$)π      ELSEπ        SOUND 600, 2π      END IFπ      π    CASE CHR$(0) + CHR$(82)                       ' Insert Keyπ      IF cursorvisible THENπ        IF insert = 1 THENπ          LOCATE ypos, xpos, 1, 0, 7π          insert = 0π        ELSEπ          LOCATE ypos, xpos, 1, 7, 7π          insert = 1π        END IFπ      ELSEπ        SOUND 600, 2π      END IFπ      π    CASE CHR$(0) + CHR$(75)                       ' Left Keyπ      IF (cursorvisible) AND (password <> 1) AND (cursorposn <> 1) THENπ        cursorposn = cursorposn - 1π        xpos = xpos - 1π      ELSEπ        SOUND 600, 2π      END IFπ      π    CASE CHR$(0) + CHR$(77)                       ' Right Keyπ      IF (cursorvisible) AND (password <> 1) THENπ        IF cursorposn <= LEN(text$) THENπ          cursorposn = cursorposn + 1π          xpos = xpos + 1π        ELSEπ          SOUND 600, 2π        END IFπ      ELSEπ        SOUND 600, 2π      END IFπ      π    CASE CHR$(8)                                  ' Backspaceπ      IF NOT (cursorposn = 1) THENπ        IF cursorposn <= LEN(text$) THENπ          text$ = LEFT$(text$, cursorposn - 2) + RIGHT$(text$, LEN(text$) - cursorposn + 1)π        ELSEIF cursorposn = (LEN(text$) + 1) THENπ          text$ = LEFT$(text$, LEN(text$) - 1)π        END IFπ        cursorposn = cursorposn - 1π        xpos = xpos - 1π      ELSEπ        SOUND 600, 2π      END IFπ      π    CASE CHR$(0) + CHR$(83)                       ' Delete Keyπ      IF (password <> 1) AND cursorposn <= LEN(text$) THENπ        text$ = LEFT$(text$, cursorposn - 1) + RIGHT$(text$, LEN(text$) - cursorposn)π      ELSEπ        SOUND 600, 2π      END IFπ      π    CASE CHR$(13)                                 ' Enter Keyπ      IF (LEN(text$) >= min) THENπ        ended = 1π      ELSEπ        SOUND 600, 2π        ended = 0π      END IFπ      π    CASE CHR$(0) + CHR$(71)                       ' Home Keyπ      IF (cursorvisible) AND (password <> 1) THENπ        cursorposn = 1π        xpos = oldxposπ      ELSEπ        SOUND 600, 2π      END IFπ      π    CASE CHR$(0) + CHR$(79)                       ' End Keyπ      IF (cursorvisible) AND (password <> 1) THENπ        cursorposn = LEN(text$) + 1π        xpos = oldxpos + LEN(text$)π      ELSEπ        SOUND 600, 2π      END IFπ      π    CASE ELSE                                     ' Any Other Keyπ      IF INSTR(permitted$, x$) THENπ        IF (insert) THENπ          IF LEN(text$) <> max THENπ            text$ = LEFT$(text$, cursorposn - 1) + x$ + RIGHT$(text$, LEN(text$) - cursorposn + 1)π            cursorposn = cursorposn + 1π            xpos = xpos + 1π          ELSEπ            SOUND 600, 2π          END IFπ        ELSEπ          IF cursorposn - 1 <> max THENπ            IF cursorposn = LEN(text$) + 1 THENπ              text$ = text$ + x$π            ELSEπ              text$ = LEFT$(text$, cursorposn - 1) + x$ + MID$(text$, cursorposn + 1, LEN(text$) - cursorposn)π            END IFπ            cursorposn = cursorposn + 1π            xpos = xpos + 1π          ELSEπ            SOUND 600, 2π          END IFπ        END IFπ      ELSEπ        SOUND 600, 2π      END IFπ      π  END SELECTπ  π  IF caps THEN text$ = UCASE$(text$)π  π  LOCATE oldypos, oldxposπ  PRINT SPACE$(max)π  π  LOCATE oldypos, oldxpos, cursorvisibleπ  π  IF password = 1 THENπ    PRINT STRING$(LEN(text$), 254) + (STRING$(max - LEN(text$), fillchar$))π  ELSEπ    PRINT text$ + STRING$(max - LEN(text$), fillchar$)π  END IFπ  πLOOP UNTIL endedππIF justify = 2 THEN                               ' Right Justifyπ  text$ = STRING$(max - LEN(text$), " ") + text$πELSEIF justify = 1 THEN                           ' Left Justifyπ  text$ = text$ + (STRING$(max - LEN(text$), " "))πEND IFππLOCATE ypos, xpos, 1, 7, 7ππEND SUBπAlexander Podkolzin            PB EDITOR                      [e-mail]         04-24-96 (10:58)       PB32                   588  16050    PBEDIT.BAS  'π' Simple Editor. Author: Alexander Podkolzin <[e-mail]>π' Use it as you want...π' PowerBASIC 3.2+π' I'v deleted all block operations from the Editor, as they wereπ' very ... don't know how to name them (may be "dummy": initial fileπ' was 2 times longer).π' PLEASE, share with me your experience if you'll rewrite this code !π' I'll appreciate any respond of You !π' Thanks for paying attention to that Editor!π'π'----------------------------------------------------------------------π  $LIB ALL OFFπ'----------------------------------------------------------------------π'π  %FALSE=0π  %TRUE=NOT %FALSEπ  %MaxLines= 10000π  %MaxLen= 240π  %FastCur= 8π  %NormAttrib = &H07π  %BlockAttrib= &H17π  %KeyAttrib = &H1Bπ  %PathAttrib = &H0Bπ  %BlnkAttrib = %BlockAttrib +&H80π  %HelpAttrib = &H17π  %HotAttrib = &H15π  %LineAttrib = &H0Aπ'π  DEFINT a-zπ'π  DIM Txt(%MaxLines) AS SHARED STRINGπ  DIM Ins AS SHARED INTEGERπ  DIM nlines AS SHARED INTEGERπ  DIM ScrnSeg AS INTEGERπ'π  IF (pbvScrnCard AND 1) = 0 THENπ    ScrnSeg = &HB800              ' color monitorπ  ELSEπ    ScrnSeg = &HB000              ' mono monitorπ  END IFπ'π  y=CSRLINπ  x=POS(0)π  FileName$=COMMAND$π  IF LEN(FileName$)=0 THENπ     Cprint x,y,"USING: PBEDIT <File Name>",%NormAttribπ     ENDπ  END IFπ'π  IF NOT FileHere(FileName$) thenπ     Cprint x,y,"File not found !",%NormAttribπ     ENDπ  END IFπ'π  InsKey$=CHR$(0,82)π  Esc$=CHR$(27)π  Home$=CHR$(0,71)π  PgUp$=CHR$(0,73)π  PgDn$=CHR$(0,81)π  Up$=CHR$(0,72)π  Down$=CHR$(0,80)π  LeftKey$=CHR$(0,75)π  RightKey$=CHR$(0,77)π  CtrlPgUp$=CHR$(0,132)π  CtrlPgDn$=CHR$(0,118)π  CtrlHome$=CHR$(0,119)π  CtrlEnd$=CHR$(0,117)π  TabKey$=CHR$(9)π  EndKey$=CHR$(0,79)π  AltX$=CHR$(0,45)                ' Quitπ'π  BcSp$ = CHR$(8)π  Enter$=CHR$(13)π  DelKey$=CHR$(0,83)π'π  CtrlB$=CHR$(2)π  CtrlC$=CHR$(3)π  CtrlK$=CHR$(11)π  CtrlL$=CHR$(12)π  CtrlN$=CHR$(14)π  CtrlQ$=CHR$(17)π  CtrlV$=CHR$(22)π  CtrlY$=CHR$(25)π'π  Ins=1π  IsChanged=%FALSEπ'π  xb=1 : yb=1 : xe=80 : ye=24     ' Editor's window coordinatesπ'                                 ' "ye" has to be less then 25!π'π  Cprint 1,ye+1,space$(80),%BlockAttribπ'π  Win 1,xb,yb,xe,ye,7,0π'π  FOR i=yb+1 to ye-1π     Cprint xe,i,CHR$(177),%NormAttribπ  NEXTπ'π  MYXA=1π'π  GOSUB LoadFileπ'π  Cprint 3,ye,"<     :   =   >",%NormAttribπ'π  Cprint xe,yb+MYXA,CHR$(219),%NormAttribπ  DOπ     Numerer nlines,lpage,begy,endyπ     GOSUB PrepareScreenπ     GOSUB ShowPage               ' lpage- length of window (page)π     Show=1                       ' begy - first line to show,π     IF nlines <1 then exit loop  ' endy - last line to show (array)π     WHILE NOT INSTAT: WEND       ' CurY - the cursor lineπ     Simb$=INKEY$π     DEF SEG=0π     POKE &H41C , peek(&H41A)     ' clear keyboard bufferπ     DEF SEGπ     SELECT CASE Simb$π        CASE InsKey$π           Ins = Ins xor 1π           Show=0π        CASE Home$π           CurX=2π           begx=1π        CASE EndKey$π           l=LEN(Txt(LineN))π           CurX=MIN(l+1,wpage)+1π           endx=MAX(l+1,wpage)+1π           begx=endx-wpageπ        CASE Up$π           IF CurY >1 thenπ              decr CurYπ              Show=0π           ELSEπ              IF begy=1 thenπ                 Show=0π              END IFπ              begy=begy-1π              endy=endy-1π              EXIT SELECTπ           END IFπ        CASE Down$π           IF CurY <lpage thenπ              INCR CurYπ              Show=0π           ELSEπ              IF endy=nlines then exit SELECTπ              INCR begyπ              INCR endyπ           END IFπ        CASE PgUp$π           begy=begy-lpageπ           IF begy<=0 then begy=1π        CASE PgDn$π           begy=begy+lpageπ           IF begy>=nlines-lpage+1 THEN begy=nlines-lpage+1π        CASE LeftKey$π           IF CurX >2 thenπ              decr CurXπ              Show=0π           ELSEπ              decr begxπ              IF begx <1 thenπ                 begx=1π                 Show=0π              END IFπ           END IFπ        CASE TabKey$π           IF CurX <79-%FastCur thenπ              INCR CurX,%FastCurπ              Show=0π           ELSEπ              begx=begx+%FastCurπ              IF begx >%MaxLen-79 then begx=%MaxLen-79π           END IFπ        CASE RightKey$π           IF CurX <79 thenπ              INCR CurXπ              Show=0π           ELSEπ              INCR begxπ              IF begx >%MaxLen-79 then begx=%MaxLen-79π           END IFπ        CASE CtrlPgUp$π           begy=1π           CurX=2π           CurY=1π        CASE CtrlPgDn$π           begy=nlines-lpage+1π           CurX=xb+1π           CurY=ye-2π        CASE CtrlHome$π           CurY=1π           Show=0π        CASE CtrlEnd$π           CurY=ye-2π           Show=0π        CASE AltX$,Esc$π           EXIT LOOPπ'π'~~~~~~~~~~~~~~   All other chars will change Txt()   ~~~~~~~~~~~~~~π        CASE Enter$π           IF Ins=1 then          ' IF "Ins" is ONπ              IsChanged=%TRUE         ' Txt() is changedπ              IF nlines=%MaxLines thenπ                 BEEP             ' too many stringsπ                 EXIT SELECTπ              END IFπ              BreakLine LineN,SimbNπ           END IFπ           CurX=2π           IF CurY < lpage thenπ              INCR CurYπ           ELSEπ              INCR begyπ           END IFπ           begx=1π'π        CASE DelKey$π           IsChanged=%TRUEπ           l=LEN(Txt(LineN))π           IF SimbN=1 and l=0 thenπ              IF nlines>1 and LineN<>nlines THENπ                 DelLine LineNπ                 INCR nlinesπ                 CurX=2π              END IFπ           ELSEIF SimbN>l and LineN=nlines THENπ              EXIT SELECTπ           ELSEπ              IF SimbN>l thenπ                 f$=Txt(LineN)+space$(SimbN-l-1)π                 IF len(f$+Txt(LineN+1))>%MaxLen THENπ                    BEEPπ                    EXIT SELECTπ                 END IFπ                 Txt(LineN)=f$+Txt(LineN+1)π                 INCR LineNπ                 DelLine LineNπ              ELSEIF l=1 thenπ                 Txt(LineN)=""π              ELSEπ                 DelChar LineN,SimbNπ              END IFπ           END IFπ'π        CASE BcSp$π           IsChanged=%TRUEπ           IF SimbN=1 AND LineN=1 THEN EXIT SELECTπ           IF SimbN=1 THENπ              IF nlines>1 THENπ                 sa$=Txt(LineN-1)π                 sb$=Txt(LineN)π                 DelLine LineNπ                 Txt(LineN-1)=sa$+sb$π                 CurX=LEN(sa$)+2π                 IF LineN>1 THENπ                    IF endy=<nlines THEN DECR CurYπ                    IF CurY<1 thenπ                       INCR CurYπ                       DECR begyπ                    END IFπ                 END IFπ              END IFπ           ELSEIF SimbN>LEN(Txt(LineN))+1 THENπ              DECR CurXπ           ELSEπ              DECR SimbNπ              DelChar LineN,SimbNπ              DECR CurXπ           END IFπ'π        CASE CtrlY$π           IsChanged=%TRUEπ           DelLine LineNπ           begx=1π           CurX=2π'π        CASE CtrlN$π           IsChanged=%TRUEπ           InsLine LineNπ'π        CASE CtrlK$π           Cprint xb+1,ye+1,"^K",%BlockAttribπ           Cprint xb+4,ye+1,"more...",%BlnkAttribπ           LOCATE ye+1,xb+3π           WHILE NOT INSTAT: wendπ           k$=INKEY$π           Cprint xb+1,ye+1,SPACE$(10),%BlockAttribπ           SELECT CASE k$π'π           END SELECTπ        CASE CtrlQ$π'π        CASE ELSEπ           IF LEN(Simb$)=1 and asc(Simb$)>31 THENπ              IsChanged=%TRUEπ              Txt(LineN)=Txt(LineN)+space$(%MaxLen)π              IF Ins=1 THENπ                 InsChar LineN,SimbN,Simb$π              ELSEπ                 ReplaceChar LineN,SimbN,Simb$π              END IFπ              INCR CurXπ              IF CurX=xe THENπ                 INCR begxπ                 CurX=xe-1π              END IFπ              Txt(LineN)=RTRIM$(Txt(LineN))π           END IFππ'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~π     END SELECTπ  LOOPπ  IF IsChanged THENπ     Win 1,xb+1,yb+1,xe-1,yb+3,7,1π     Cprint xb+3,yb+2,"File is changed, save ? (Y/N) ",%HelpAttribπ     DOπ        WHILE NOT INSTAT: wendπ        s$=INKEY$π        SELECT CASE s$π           CASE "Y","y"π              GOSUB SaveFileπ              EXIT LOOPπ           CASE "N","n"π              EXIT LOOPπ        END SELECTπ     LOOPπ  END IFπ'π' Clear screen before exitπ'π  Cprint 1,1,space$(2000),%NormAttribπ  LOCATE ,,,11,12π  ENDπ'----------------------------------------------------------------------ππShowPage:π  IF Show=0 THEN RETURNπ  FOR i=1 TO lpageπ     n = begy+i-1π     Txt(n)=RTRIM$(Txt(n))π     l = LEN(Txt(n))π     s$=MID$(Txt(n)+space$(%MaxLen - l),begx,wpage)π     Cprint xb+1,yb+i,s$,%NormAttribπ  NEXT iπ  RETURNπ'----------------------------------------------------------------------ππPrepareScreen:π'π' Show Cursor:π'π  LineN=begy+CurY-1π  SimbN=begx+Curx-2π  Cprint 4,ye,RIGHT$("0000"+LTRIM$(STR$(LineN)),5),%PathAttribπ  Cprint 10,ye,RIGHT$("00"+LTRIM$(STR$(SimbN)),3),%PathAttribπ  Cprint 14,ye,RIGHT$("00"+LTRIM$(STR$(SCREEN(CurY+1,CurX ))),3),%PathAttribπ  IF CurX < xb+1 THEN CurX= xb+1π  IF CurX >xe-1 THEN CurX=xe-1π  IF CurY >nlines then CurY=nlinesπ  LOCATE yb+CurY,CurX,1π'π' Make Ruler:π'π  IF Nlines > lpage thenπ     om=MYXAπ     MYXA=((begy+CurY-1)/nlines )*(ye-yb-1)π     IF MYXA=0 then MYXA=1π     IF om <> MYXA thenπ        Cprint xe,yb+om,CHR$(177),%NormAttribπ        Cprint xe,yb+MYXA,CHR$(219),%NormAttribπ     END IFπ  END IFπ'π' Show Keys:π'π  IF Ins=1 THENπ     LOCATE ,,,4,12π     sa$="INS"π  ELSEπ     locate ,,,11,12π     sa$ = "   "π  END IFπ  Cprint 71,ye+1,sa$,%BlockAttribπ'π' Show Size:π'π  Size&=-1π  FOR i=1 to nlinesπ     Size&=Size&+LEN(Txt(i))+2π  NEXTπ  Cprint 35,ye,"<Lines:     >",%NormAttribπ  Cprint 65,ye,"<Size:",%NormAttribπ  Cprint 78,ye,">",%NormAttribπ  Cprint 42,ye,RIGHT$("      "+STR$(nlines),5),%PathAttribπ  Cprint 71,ye,RIGHT$("      "+STR$( Size&),7),%PathAttribπ'π' Check if the editor file is changedπ'π  IF NOT IsChanged THENπ     Cprint 19,ye,"=",%NormAttribπ  ELSEπ     Cprint 19,ye,"÷",%PathAttribπ  END IFπ  RETURNπ'----------------------------------------------------------------------π  FUNCTION FileHere (FileNAME$)π     S$=DIR$(FileNAME$)π     IF LEN(S$)=0 THENπ        FileHere = 0π     ELSEπ        FileHere =-1π     END IFπ  END FUNCTIONπ'----------------------------------------------------------------------π  SUB BreakLine(LineN,SimbN)      ' Separates LineN-th string for twoπ'                                 ' at SimbN-th positionπ     sa$=MID$(Txt(LineN),1,SimbN-1)π     sb$=MID$(Txt(LineN),SimbN,%MaxLen)π     ARRAY INSERT Txt(LineN)π     Txt(LineN)=sa$π     Txt(LineN+1)=sb$π     INCR nlinesπ  END SUBπ'----------------------------------------------------------------------π  SUB DelLine(LineN)              ' Deletes LineN-th lineπ     ARRAY DELETE Txt(LineN)π     DECR nlinesπ  END SUBπ'----------------------------------------------------------------------π  SUB InsLine(LineN)π     BreakLine LineN,LEN(Txt(LineN))+1π  END SUBπ'----------------------------------------------------------------------π  SUB InsChar(LineN,SimbN,Simb$)π     s$=Txt(LineN)π     Txt(LineN)=LEFT$(s$,SimbN-1)+Simb$+RIGHT$(s$,LEN(s$)-SimbN+1)π  END SUBπ'----------------------------------------------------------------------π' Replacement of a charπ  SUB ReplaceChar(LineN,SimbN,Simb$)π     MID$(Txt(LineN),SimbN)=Simb$π  END SUBπ'----------------------------------------------------------------------π  SUB DelChar(LineN,SimbN)π     s$=Txt(LineN)π     Txt(LineN)=LEFT$(s$,SimbN-1) + RIGHT$(s$,LEN(s$)-SimbN)π  END SUBπ'---------------------------------------------------------------------------ππSaveFile:π  IF NOT IsChanged THEN RETURNπ  Cprint 3,ye+1,"Saving...",%BlnkAttribπ  n=INSTR(FileName$,".")π  IF n<>0 THENπ     n$=LEFT$(FileName$,n-1)      'π     e$=".APP"                    ' Extension for changed file.π  ELSE                            'π     n$=FileName$π     e$=".APP"π  END IFπ  IF FileHere(n$+e$) THENπ     KILL n$+e$π  END IFπ  DestFile=FREEFILEπ  OPEN n$+e$ FOR OUTPUT AS DestFileπ  FOR i=1 to nlinesπ     PRINT #DestFile,Txt(i)π  NEXTπ  CLOSE DestFileπ  Cprint 3,ye+1,SPACE$(10),%BlockAttribπ  IsChanged=%FALSEπ  GOSUB PrepareScreenπ  RETURNπ'---------------------------------------------------------------------------ππLoadFile:π  redim Txt(%MaxLines)π  Cprint 3,yb+1,"Loading...",%NormAttrib + &H80π  src=FREEFILEπ  OPEN FileName$ FOR INPUT as srcπ  i=0π  DO WHILE EOF(src )=0 AND i < %MaxLinesπ     INCR iπ     LINE INPUT #src,Txt(i)π' Double load timeπ     REPLACE CHR$(9) with "        " IN Txt(i )π  LOOPπ  Size&= LOF(src )+1π  CLOSE srcπ  nlines=i+1π  Txt(nlines )=""π'π  x=(80- LEN(FileName$)) \ 2π  Cprint x-1,yb,repeat$(LEN(FileName$)+2,CHR$(196)),%NormAttribπ  Cprint x,yb,UCASE$(FileName$),%PathAttribπ  begx=1π  begy=1π  lpage=ye-yb-1π  wpage=xe-xb-1π  endy=MIN(lpage,nlines )π  CurY=1π  CurX=2π  SimbN=1π  Show=1π  LOCATE yb+1,xb+1π  RETURNπ'---------------------------------------------------------------------------π' "Numerer" normalizes begy% and begx%π  SUB Numerer(nlines%,lpage%,begy%,endy%)π     IF nlines%<=lpage% THENπ        begy%=1π        endy%=nlines%π        EXIT SUBπ     END IFπ     IF begy%<1 THENπ        begy%=1π        endy%=begy%+lpage%-1π        EXIT SUBπ     END IFπ     IF begy%+lpage%-1>=nlines% THENπ        endy%=nlines%π        begy%=nlines%-lpage%+1π        EXIT SUBπ     END IFπ     endy%=begy%+lpage%-1π  END SUBπ'----------------------------------------------------------------------------π  SUB Win(t%,xb%,yb%,xe%,ye%,ct%,cb%)π'π     OldColor% = pbvScrnTxtAttr   ' Internal PB variableπ'π     SELECT CASE t%               ' Window typesπ'                                 ' (you can make as much types,π'                                 ' as you want):π        CASE 1π           a%=218:b%=196:c%=191   ' Single frameπ           h%=179:      :d%=179π           g%=192:f%=196:e%=217π        CASE 2π           a%=201:b%=205:c%=187   ' Double frameπ           h%=186:      :d%=186π           g%=200:f%=205:e%=188π        CASE ELSEπ           a%=032:b%= a%:c%=a%    ' Blanks onlyπ           h%= a%:      :d%=a%π           g%= a%:f%= a%:e%=a%π     END SELECTπ'π     COLOR ct%,cb%π'π     LOCATE yb%,xb%π     PRINT CHR$(a%)+REPEAT$(xe%-xb%-1,CHR$(b%))+CHR$(c%);π'π     FOR i%=yb%+1 TO ye%-1π        LOCATE i%,xb%π        PRINT CHR$(h%) + SPACE$(xe%-xb%-1) +CHR$(d%);π     NEXTπ'π     LOCATE ye%,xb%π     PRINT CHR$(g%)+REPEAT$(xe%-xb%-1,CHR$(f%))+CHR$(e%);π'π     ct%=OldColor% AND 15         ' restore colorsπ     cb%=OldColor% \ 16π     COLOR ct%,cb%π  END SUBπ'----------------------------------------------------------------------------π  SUB PutAttribute(x%,y%,t%,b%)   ' Puts attribute byte to video memoryπ     LOCAL c%                     ' directly to Colomn, Row positionπ     c% = b%*16+t%π     DEF SEG = ScrnSegπ     POKE 160*(y%-1)+x%+x%-1,c%π     DEF SEGπ  END SUBπ'----------------------------------------------------------------------------π  SUB Cprint(x%,y%,s$,attr%)      ' Color printingπ     LOCATE ,,0                   ' For more speed better to useπ     REG 1,&H1300                 ' ASSEMBLER subroutineπ     REG 2,attr%π     REG 3,LEN(s$)π     REG 4,(y%-1)*256+x%-1π     REG 9,STRSEG(s$)π     REG 7,STRPTR(s$)π     CALL INTERRUPT &H10π     LOCATE ,,1π  END SUBπ'----------------------------------------------------------------------π 1         78   ARABIC TO ROMAN NUMERALS       Jeff S. Root                    2393      459  MATH TEST                      Dave Gjessing                   17934     93   BUBBLE SORT                    Dave Gjessing                   21337     175  EXPRESSION EVALUATOR           Christopher Pinder              25827     90   EXTRACT/SET LOW & HIGH BYTES   Larry Stone                     1         87   MONITOR SHELL & GET ERRORLEVEL Tony Elliott                    1         815  POSTIT! 5.0 FOR VB/DOS         Brent Ashley                    1         234  CLOCK SET                      Douglas Lusher                  7034      729  CALCULATE DAY OF WEEK          Steve M. Wiegand                1         194  RAD VGA/ANSI DEMO              Andrew Jones                    12800     73   GAME OF LIFE ALGORITHM         Aaron Scott Zabudsky            18103     70   SILLY GAME                     Andrew Jones                    19874     83   LINE & CIRCLE REPLACEMENTS     Justin Pasher                   1         75   LIST OF DRIVES                 Larry Stone                     1         173  DETECT COMPUTER PROCESSOR UNIT Thomas Gohel                    4950      190  PATH CHECK                     Jim Emptage                     9650      35   DETECT IF SHARE IS LOADED      Robert Fortune                  11591     18   ERRORLEVEL OF RETURNED SHELL   Geoffrey Liu                    12444     13   EXITING WITH ERRORLEVEL        Joey Shaw                       12942     107  CHECK IF IN A SHELL            Tony Elliott                    1         338  ROTATING DNA ANALYSIS          Sean Smith                      8988      140  BLOCK FILL                     David J. Arigan                 13245     168  ANOTHER PAINT REPLACEMENT      Rich Gordley                    16482     25   LINE BOUNCER                   Isaac Grover                    17734     72   WRITE 640X480X16 .BMP FILES    Mathew Robertson                20661     35   GRAVITY LINES                  Stephan Doughty                 23128     83   BOUNCING LINES IN 3D BOX       Stephan Doughty                 28181     90   FLYING BEES & WASP             Richard Dale                    1         26   VGA/SVGA INTERRUPTS            Mike Huff                       1320      2114 I/O PORT ADDRESSES             Wim Osterholt                   78297     109  HEXADECIMAL AND BINARY NOTATIONEarl L. Montgomery              1         1051 CHRISTMAS HAK-MAN              Nicolas Culberson               30619     808  FIRE STORM                     Tim Desper                      50999     237  JACK'S GAME                    Jacques Mallah                  63996     160  COMBAT GAME                    Jacques Mallah                  71994     308  SPHERE FIGHTER                 Mike Hulme & Co.                91960     2096 BALLOON X                      Manny Najera                    156135    376  THE ADVENTURE                  Chris Kerton                    172335    321  AZTEC TOMB PART I              A. R. Crowther                  193400    84   GENERIC HORSE RACING GAME      Eric Benoit                     195402    370  THE BIOTECH INSTITUTE          David Carlton                   220103    240  DUNGEON RPG GAME               Jonathan Hopkinson              235793    185  SPACE DUEL                     Jonathan Hopkinson              248054    326  TIC-TAC-TOE VIA MODEM          Kevin Fowlks                    256137    68   SPACE INVADERS                 Alan Bruzzi                     259153    268  BOX-CAR RACES                  Justin Pasher                   265349    191  LUNAR LANDER                   Chris Sequeria                  277974    82   MISSILE                        Kenneth Green                   281322    66   TANK!!!                        Kenneth Green                   285703    272  TRY - LIKE TETRIS              Mike Hulme                      298599    903  IMMORTAL KOMBAT II             John Diamond                    316925    139  (SONIC) SPINBALL               Eric Carr                       326171    53   SPINBALL GAME UPDATE           Eric Carr                       329821    177  TETRIS (TEXT MODE)             Joshua Dickerson                1         93   320X400 SCREEN MODE            Earl L. Montgomery              3481      84   SCROLLING OVER VGA-BIOS        Thomas Gohel                    5826      215  PAC-MAN SCREEN SAVER           Chad Beck                       11354     341  VESA SVGA SCREEN ROUTINES      Tyler Barnes                    23621     108  QBASIC FADING ROUTINE          Manny Najera                    26209     429  3D-VR MAZE WARS                David Carlton                   38760     62   STARFIELD WITH BACKGROUND MUSICTyler Barnes                    41102     45   SCALE SPRITE                   Eric Carr                       42934     164  3D MATRIX ROTATIONS            Peder Brynolf                   46087     151  2D ROTATING TEXTURE MAPS       Peder Brynolf                   48540     25   COLOR BARS THAT COLOR CYCLE    Aaron Scott Zabudsky            49098     14   COMPUTERIZED SPIROGRAPH        Aaron Scott Zabudsky            49599     29   REVERSING SCREEN IMAGE         Earl L. Montgomery              50477     58   BACK SWITCHING                 Earl L. Montgomery              51978     30   TGA VIEWER (320X200)           Jeff Lawson                     52752     37   ANIMATION OF RUNNING MAN       Dave Shea                       55244     136  COLORFUL WORMHOLE              Unknown Author(s)               64231     694  GRAPHICS DRAWING PROGRAM       Einar Tveit                     76968     63   BOUNCING WORM                  Andrew Jones                    78607     62   BOX ENLARGES AS BALL BOUNCES   Andrew Jones                    80057     26   SNOWY RAIN                     Andrew Jones                    80725     1238 MOUSE PAINT PROGRAM            Unknown Author(s)               112000    306  TILE GRAPHICS                  James Tonn                      125735    52   SMALL FONT (8X8 SANS SERIF)    Michael J. Kelly                129243    135  VESA MANDELBROT                Earl L. Montgomery              133543    124  SPRITE(BITMAP) EDITOR          Joshua Dickerson                1         88   MONITOR INTERRUPTS             Tyler Barnes                    1         70   SIMULTANEOUS KEY DEMO          Eric Carr                       3107      119  DETECT KEYDOWN & KEYUP EVENTS  Eric Benson                     6692      36   LEFT/RIGHT SHIFT (USING BITS)  Jeremy Stanley                  1         556  MEMORY VIEW                    Tyler Barnes                    1         166  SIMPLE QWK READER              The ABC Programmer              5089      144  CREATE WORD SEARCH PUZZLES     Justin McCall                   14658     292  DUMP OUTBOUND.HIS TO TEXT FILE Justin Pasher                   24279     200  LED CLOCK DISPLAY              Douglas H. Lusher               29848     1067 INSTALLATION UTILITY           Ethan Winer                     68481     494  ADVANCED QWK READER            The ABC Programmer              83432     64   TYPING DRILL                   Andrew Jones                    1         110  COM SUPPORT                    Michael Parker                  3384      192  DIAL A PHONE NUMBER            Dick Dennison                   1         474  MOUSE DEMO                     Hardin Brothers                 12676     402  GRAPHICAL MOUSE USAGE          John Rodgers                    23028     361  GRAPHICAL MOUSE CURSORS DEMO   Brian Roche                     35763     69   PSYCHADELIC ELVIS MOUSEBOY     Dave Shea                       38416     46   ANIMATED MOUSE CURSOR          Dave Shea                       41384     394  LALEH'S MOUSE ROUTINES V2.0    Jamshid Khoshrangi              67253     218  PB MOUSE TIC-TAC-TOE DEMO      The ABC Programmer              74614     18   HAND MOUSE POINTER BITMAP      Mike Wegner                     1         231  NOVELL NETWARE ROUTINES        Greg Shultz/Dave Navarro, Jr.   6987      40   RETURNS DESQVIEW VERSION       Dave Navarro, Jr.               1         215  ANSI VIEWER                    Dave Navarro, Jr.               5064      138  PERCENTAGE BAR ROUTINE         James Goldbloom                 11593     94   SWAP ARRAYS IN PB              Dave Navarro, Jr.               1         28   MIDI CODE FOR THE SBSIM        Mike Huff                       1136      107  PB .WAV PLAYER                 Dave Navarro, Jr.               4951      377  BACKGROUND WAV/VOC PLAY/RECORD Mike Huff                       14908     88   SOUND BLASTER OSCILLISCOPE     Andrew Jones                    16604     131  SOUND AFFECTS                  Daniel Minty                    1         267  SIMPLE FILE BROWSER            Alexander Podkolzin             7362      30   80X28 TEXT MODE                Douglas H. Lusher               8392      78   FAST LINE INPUT REPLACEMENT    Ethan Winer                     11727     46   SMOOTH VERTICAL SCROLL         Peter Cooper                    12811     227  GET/PUT IN TEXT                Carl Gorringe                   20545     1214 TEXT EDITOR                    Douglas H. Lusher               54753     250  STRING EDIT/INPUT ROUTINE      Naushir Patuck                  61200     588  PB EDITOR                      Alexander Podkolzin